-- | @update@ input handler.
module Unison.Codebase.Editor.HandleInput.Update2
  ( handleUpdate2,

    -- * Misc helpers to be organized later
    typecheckedUnisonFileToBranchUpdates,
  )
where

import Control.Lens (mapped, (.=), (?=))
import Control.Monad.Reader.Class (ask)
import Data.Bifoldable (bifoldMap)
import Data.Map qualified as Map
import Data.Map.Merge.Strict qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Data.Text qualified as Text
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import TextBuilder qualified
import U.Codebase.Reference (TermReferenceId)
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty qualified as Pretty
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Cli.UpdateUtils (getNamespaceDependentsOf, hydrateRefs, makeUniqueTypeGuids, nameHydratedRefIds, parseAndTypecheck, subtractDependents)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch, Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch
import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch
import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge
import Unison.Codebase.Editor.Output (Output)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as Decl
import Unison.DeclCoherencyCheck qualified as DeclCoherencyCheck
import Unison.DeclNameLookup (DeclNameLookup (..))
import Unison.Merge qualified as Merge
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names (Names))
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Project (ProjectAndBranch (..), projectBranchNameToValidProjectBranchNameText)
import Unison.Reference (TypeReferenceId)
import Unison.Reference qualified as Reference (fromId)
import Unison.Referent qualified as Referent
import Unison.Sqlite (Transaction)
import Unison.Symbol (Symbol)
import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile)
import Unison.Syntax.Name qualified as Name
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.UnisonFile.Type (TypecheckedUnisonFile)
import Unison.Util.Alphabetical (sortAlphabeticallyOn)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set
import Unison.WatchKind qualified as WK
import Witch (unsafeFrom)

useUpdateV2 :: Bool
useUpdateV2 :: Bool
useUpdateV2 =
  Bool -> Bool
not (Bool -> Bool)
-> (IO (Maybe FilePath) -> Bool) -> IO (Maybe FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool)
-> (IO (Maybe FilePath) -> Maybe FilePath)
-> IO (Maybe FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe FilePath) -> Maybe FilePath
forall a. IO a -> a
unsafePerformIO (IO (Maybe FilePath) -> Bool) -> IO (Maybe FilePath) -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"UNISON_USE_UPDATE_V1"
{-# NOINLINE useUpdateV2 #-}

handleUpdate2 :: Cli ()
handleUpdate2 :: Cli ()
handleUpdate2 = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  tuf <- Cli.expectLatestTypecheckedFile
  pp <- Cli.getCurrentProjectPath
  let projectId = ProjectPath
pp.project.projectId
  currentBranch <- Cli.getCurrentBranch
  let currentBranch0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
currentBranch
  let namesIncludingLibdeps = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch0

  -- Assert that the namespace doesn't have any conflicted names
  unconflictedView <-
    Branch.asUnconflicted currentBranch0
      & onLeft (Cli.returnEarly . Output.ConflictedDefn)

  -- Assert that the namespace doesn't have any incoherent decls
  declNameLookup <-
    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)

  -- Of all the namespace bindings in the latest typechecked Unison file, keep the ones that don't correspond to "no
  -- change" (i.e. the thing was just `edit`-ed and untouched). We also reject the update entirely if it touches
  -- anything in lib.*.
  let addedOrUpdatedNamespaceBindings0 :: Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
      addedOrUpdatedNamespaceBindings0 =
        let f :: (Eq ref1) => Relation Name ref1 -> (ref2 -> ref1) -> Name -> ref2 -> (Set Name, Bool)
            f :: forall ref1 ref2.
Eq ref1 =>
Relation Name ref1
-> (ref2 -> ref1) -> Name -> ref2 -> (Set Name, Bool)
f Relation Name ref1
libdeps ref2 -> ref1
toRef Name
name ref2
fileRef
              | Name -> NameSegment -> Bool
Name.beginsWithSegment Name
name NameSegment
NameSegment.libSegment,
                Bool -> (ref1 -> Bool) -> Maybe ref1 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ref1 -> ref1 -> Bool
forall a. Eq a => a -> a -> Bool
/= ref2 -> ref1
toRef ref2
fileRef) (Set ref1 -> Maybe ref1
forall a. Set a -> Maybe a
Set.asSingleton (Name -> Relation Name ref1 -> Set ref1
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Name
name Relation Name ref1
libdeps)) =
                  (Name -> Set Name
forall a. a -> Set a
Set.singleton Name
name, Bool
False)
              | Bool
otherwise = (Set Name
forall a. Set a
Set.empty, Bool
False)
            g :: (Eq ref1) => (ref2 -> ref1) -> name -> ref1 -> ref2 -> Maybe Bool
            g :: forall ref1 ref2 name.
Eq ref1 =>
(ref2 -> ref1) -> name -> ref1 -> ref2 -> Maybe Bool
g ref2 -> ref1
toRef name
_ ref1
codebaseRef ref2
fileRef
              | ref1
codebaseRef ref1 -> ref1 -> Bool
forall a. Eq a => a -> a -> Bool
== ref2 -> ref1
toRef ref2
fileRef = Maybe Bool
forall a. Maybe a
Nothing
              | Bool
otherwise = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            h :: (Eq ref1) => Relation Name ref1 -> (ref2 -> ref1) -> BiMultimap ref1 Name -> Map Symbol ref2 -> (Set Name, Map Name Bool)
            h :: forall ref1 ref2.
Eq ref1 =>
Relation Name ref1
-> (ref2 -> ref1)
-> BiMultimap ref1 Name
-> Map Symbol ref2
-> (Set Name, Map Name Bool)
h Relation Name ref1
libdeps ref2 -> ref1
toRef BiMultimap ref1 Name
codebaseDefns Map Symbol ref2
fileDefns =
              WhenMissing ((,) (Set Name)) Name ref1 Bool
-> WhenMissing ((,) (Set Name)) Name ref2 Bool
-> WhenMatched ((,) (Set Name)) Name ref1 ref2 Bool
-> Map Name ref1
-> Map Name ref2
-> (Set Name, Map Name Bool)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
                WhenMissing ((,) (Set Name)) Name ref1 Bool
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
                ((Name -> ref2 -> (Set Name, Bool))
-> WhenMissing ((,) (Set Name)) Name ref2 Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing (Relation Name ref1
-> (ref2 -> ref1) -> Name -> ref2 -> (Set Name, Bool)
forall ref1 ref2.
Eq ref1 =>
Relation Name ref1
-> (ref2 -> ref1) -> Name -> ref2 -> (Set Name, Bool)
f Relation Name ref1
libdeps ref2 -> ref1
toRef))
                ((Name -> ref1 -> ref2 -> Maybe Bool)
-> WhenMatched ((,) (Set Name)) Name ref1 ref2 Bool
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ((ref2 -> ref1) -> Name -> ref1 -> ref2 -> Maybe Bool
forall ref1 ref2 name.
Eq ref1 =>
(ref2 -> ref1) -> name -> ref1 -> ref2 -> Maybe Bool
g ref2 -> ref1
toRef))
                (BiMultimap ref1 Name -> Map Name ref1
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap ref1 Name
codebaseDefns)
                ((Symbol -> Name) -> Map Symbol ref2 -> Map Name ref2
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Map Symbol ref2
fileDefns)
         in (BiMultimap Referent Name
 -> Map Symbol Id -> (Set Name, Map Name Bool))
-> (BiMultimap Reference Name
    -> Map Symbol TermReferenceId -> (Set Name, Map Name Bool))
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Defns (Map Symbol Id) (Map Symbol TermReferenceId)
-> Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith
              (Relation Name Referent
-> (Id -> Referent)
-> BiMultimap Referent Name
-> Map Symbol Id
-> (Set Name, Map Name Bool)
forall ref1 ref2.
Eq ref1 =>
Relation Name ref1
-> (ref2 -> ref1)
-> BiMultimap ref1 Name
-> Map Symbol ref2
-> (Set Name, Map Name Bool)
h Names
namesIncludingLibdeps.terms Id -> Referent
Referent.fromId)
              (Relation Name Reference
-> (TermReferenceId -> Reference)
-> BiMultimap Reference Name
-> Map Symbol TermReferenceId
-> (Set Name, Map Name Bool)
forall ref1 ref2.
Eq ref1 =>
Relation Name ref1
-> (ref2 -> ref1)
-> BiMultimap ref1 Name
-> Map Symbol ref2
-> (Set Name, Map Name Bool)
h Names
namesIncludingLibdeps.types TermReferenceId -> Reference
Reference.fromId)
              UnconflictedLocalDefnsView
unconflictedView.defns
              (TypecheckedUnisonFile Symbol Ann
-> Defns (Map Symbol Id) (Map Symbol TermReferenceId)
forall v a.
Ord v =>
TypecheckedUnisonFile v a -> DefnsF (Map v) Id TermReferenceId
UF.namespaceBindingsMap TypecheckedUnisonFile Symbol Ann
tuf)

  let thingsInLibBeingAddedOrUpdated :: Set Name
      thingsInLibBeingAddedOrUpdated =
        ((Set Name, Map Name Bool) -> Set Name)
-> ((Set Name, Map Name Bool) -> Set Name)
-> Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
-> Set Name
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (Set Name, Map Name Bool) -> Set Name
forall a b. (a, b) -> a
fst (Set Name, Map Name Bool) -> Set Name
forall a b. (a, b) -> a
fst Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
addedOrUpdatedNamespaceBindings0

  whenJust (Set.NonEmpty.nonEmptySet thingsInLibBeingAddedOrUpdated) \NESet Name
things ->
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (NESet Name -> Output
Output.CantUpdateLib NESet Name
things)

  let addedOrUpdatedNamespaceBindings :: DefnsF Set Name Name
      addedOrUpdatedNamespaceBindings =
        ((Set Name, Map Name Bool) -> Set Name)
-> ((Set Name, Map Name Bool) -> Set Name)
-> Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
-> 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 (Map Name Bool -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (Map Name Bool -> Set Name)
-> ((Set Name, Map Name Bool) -> Map Name Bool)
-> (Set Name, Map Name Bool)
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Name, Map Name Bool) -> Map Name Bool
forall a b. (a, b) -> b
snd) (Map Name Bool -> Set Name
forall k a. Map k a -> Set k
Map.keysSet (Map Name Bool -> Set Name)
-> ((Set Name, Map Name Bool) -> Map Name Bool)
-> (Set Name, Map Name Bool)
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Name, Map Name Bool) -> Map Name Bool
forall a b. (a, b) -> b
snd) Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
addedOrUpdatedNamespaceBindings0

  let 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)

  finalOutput <-
    Cli.label \forall a. Output -> Cli a
done ->
      ((Output -> Cli ()) -> Cli Output) -> Cli Output
forall a. ((Output -> Cli ()) -> Cli a) -> Cli a
Cli.withRespondRegion \Output -> Cli ()
respondRegion -> do
        Output -> Cli ()
respondRegion (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
          Pretty ColorText -> Output
Output.Literal (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pretty.wrap Pretty ColorText
"Okay, I'm searching the branch for code that needs to be updated...")

        (dependents, dependentsRefs, hydratedDependents) <-
          Transaction
  (DefnsF (Map Name) TermReferenceId TermReferenceId,
   DefnsF Set TermReferenceId TermReferenceId,
   DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> Cli
     (DefnsF (Map Name) TermReferenceId TermReferenceId,
      DefnsF Set TermReferenceId TermReferenceId,
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
            -- Get all dependents of things being updated
            dependents0 <-
              Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF Set Reference Reference
-> Transaction (DefnsF (Map Name) TermReferenceId TermReferenceId)
getNamespaceDependentsOf
                UnconflictedLocalDefnsView
unconflictedView.defns
                ( Names -> DefnsF Set Reference Reference
Names.references
                    Names
                      { terms :: 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
addedOrUpdatedNamespaceBindings.terms UnconflictedLocalDefnsView
unconflictedView.names.terms,
                        types :: Relation Name Reference
types = Set Name -> Relation Name Reference -> Relation Name Reference
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.restrictDom DefnsF Set Name Name
addedOrUpdatedNamespaceBindings.types UnconflictedLocalDefnsView
unconflictedView.names.types
                      }
                )

            -- Throw away the dependents that are shadowed by the file itself
            let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId
                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

            let dependentsRefs :: DefnsF Set TermReferenceId TypeReferenceId
                dependentsRefs =
                  (Map Name TermReferenceId -> Set TermReferenceId)
-> (Map Name TermReferenceId -> Set TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> 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 ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1

            -- Hydrate the dependents for rendering
            hydratedDependents0 <-
              hydrateRefs env.codebase dependentsRefs

            let hydratedDependents1 =
                  DefnsF (Map Name) TermReferenceId TermReferenceId
-> Defns
     (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
forall name term typ.
DefnsF (Map name) TermReferenceId TermReferenceId
-> Defns (Map TermReferenceId term) (Map TermReferenceId typ)
-> DefnsF (Map name) (TermReferenceId, term) (TermReferenceId, typ)
nameHydratedRefIds DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1 Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDependents0

            pure (dependents1, dependentsRefs, hydratedDependents1)

        secondTuf <- do
          case defnsAreEmpty dependents of
            -- If there are no dependents of the updates, then just use the already-typechecked file.
            Bool
True -> TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypecheckedUnisonFile Symbol Ann
tuf
            Bool
False -> do
              Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pretty.wrap Pretty ColorText
"That's done. Now I'm making sure everything typechecks..."))

              let prettyUnisonFile :: Pretty ColorText
prettyUnisonFile =
                    let ppe :: PrettyPrintEnvDecl
ppe = Int
-> Names
-> Names
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> PrettyPrintEnvDecl
makePPE Int
10 Names
namesIncludingLibdeps (TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
tuf) DefnsF (Map Name) TermReferenceId TermReferenceId
dependents
                     in Pretty ColorText
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
makePrettyUnisonFile
                          (PrettyPrintEnvDecl -> UnisonFile Symbol Ann -> Pretty ColorText
forall v a.
(Var v, Ord a) =>
PrettyPrintEnvDecl -> UnisonFile v a -> Pretty ColorText
Pretty.prettyUnisonFile PrettyPrintEnvDecl
ppe (TypecheckedUnisonFile Symbol Ann -> UnisonFile Symbol Ann
forall v a. Ord v => TypecheckedUnisonFile v a -> UnisonFile v a
UF.discardTypes TypecheckedUnisonFile Symbol Ann
tuf))
                          ( DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
forall a v.
(Var v, Monoid a) =>
DeclNameLookup
-> PrettyPrintEnvDecl
-> Set Name
-> DefnsF
     (Map Name) (Term v a, Type v a) (TermReferenceId, Decl v a)
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
renderDefnsForUnisonFile
                              DeclNameLookup
declNameLookup
                              PrettyPrintEnvDecl
ppe
                              Set Name
forall a. Set a
Set.empty
                              (ASetter
  (DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
  (DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
-> ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> (Term Symbol Ann, Type Symbol Ann))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TermReferenceId, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann)
-> Identity
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
#terms ((Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
 -> DefnsF
      (Map Name)
      (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TermReferenceId, Decl Symbol Ann)
 -> Identity
      (DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TermReferenceId, Decl Symbol Ann)))
-> (((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     -> Identity (Term Symbol Ann, Type Symbol Ann))
    -> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> ASetter
     (DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TermReferenceId, Decl Symbol Ann))
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Identity (Map Name (Term Symbol Ann, Type Symbol Ann))
Setter
  (Map Name (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (Term Symbol Ann, Type Symbol Ann)
forall a b. (a, b) -> b
snd DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedDependents)
                          )

              parsingEnv <-
                ProjectPath -> Names -> Cli (ParsingEnv Transaction)
Cli.makeParsingEnv ProjectPath
pp Names
namesIncludingLibdeps

              secondTuf <-
                parseAndTypecheck prettyUnisonFile parsingEnv & onNothingM do
                  if useUpdateV2
                    then do
                      let nextNamespace :: Branch IO
                          nextNamespace =
                            UnconflictedLocalDefnsView
unconflictedView.defns
                              Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> (Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
    -> Defns (Map Name Referent) (Map Name Reference))
-> Defns (Map Name Referent) (Map Name Reference)
forall a b. a -> (a -> b) -> b
& (BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap Reference Name -> Map Name Reference)
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Defns (Map Name Referent) (Map Name Reference)
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
                                ( BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range
                                    (BiMultimap Referent Name -> Map Name Referent)
-> (Map Name Referent -> Map Name Referent)
-> BiMultimap Referent Name
-> Map Name Referent
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ( Map Name Referent -> Set Name -> Map Name Referent
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys`
                                            -- Toss (by name):
                                            --   1. the terms in the file
                                            --   2. the old constructors of the types in the file
                                            ( (Set Name -> Name -> Bool -> Set Name)
-> Set Name -> Map Name Bool -> Set Name
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
                                                ( \Set Name
acc Name
typeName Bool
isUpdate ->
                                                    if Bool
isUpdate
                                                      then
                                                        (Name -> Set Name -> Set Name) -> Set Name -> [Name] -> Set Name
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                                          Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert
                                                          Set Name
acc
                                                          ( [Name] -> Name -> Map Name [Name] -> [Name]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
                                                              [] -- impossible, could error
                                                              Name
typeName
                                                              DeclNameLookup
declNameLookup.declToConstructors
                                                          )
                                                      else Set Name
acc
                                                )
                                                DefnsF Set Name Name
namespaceBindings.terms
                                                ((Set Name, Map Name Bool) -> Map Name Bool
forall a b. (a, b) -> b
snd Defns (Set Name, Map Name Bool) (Set Name, Map Name Bool)
addedOrUpdatedNamespaceBindings0.types)
                                            )
                                        )
                                )
                                (BiMultimap Reference Name -> Map Name Reference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (BiMultimap Reference Name -> Map Name Reference)
-> (Map Name Reference -> Map Name Reference)
-> BiMultimap Reference Name
-> Map Name Reference
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Map Name Reference -> Set Name -> Map Name Reference
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.types))
                              Defns (Map Name Referent) (Map Name Reference)
-> (Defns (Map Name Referent) (Map Name Reference)
    -> Defns (Map Name Referent) (Map Name Reference))
-> Defns (Map Name Referent) (Map Name Reference)
forall a b. a -> (a -> b) -> b
& DefnsF Set TermReferenceId TermReferenceId
-> Defns (Map Name Referent) (Map Name Reference)
-> Defns (Map Name Referent) (Map Name Reference)
subtractDependents DefnsF Set TermReferenceId TermReferenceId
dependentsRefs
                              Defns (Map Name Referent) (Map Name Reference)
-> (Defns (Map Name Referent) (Map Name Reference) -> Branch0 IO)
-> Branch0 IO
forall a b. a -> (a -> b) -> b
& Defns (Map Name Referent) (Map Name Reference) -> Branch0 IO
forall (m :: * -> *).
Defns (Map Name Referent) (Map Name Reference) -> Branch0 m
Branch.fromUnconflictedDefns
                              Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m -> Branch0 m
Branch.setLibdeps (Path -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 (NameSegment -> Path
Path.singleton NameSegment
NameSegment.libSegment) Branch0 IO
currentBranch0)
                              Branch0 IO -> (Branch0 IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& (Branch0 IO -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
`Branch.cons` Branch IO
currentBranch)

                      if pp.branch.isUpdate || pp.branch.isUpgrade || pp.branch.isMerge
                        then do
                          Cli.updateProjectBranchRoot_ pp.branch "update" (const nextNamespace)
                          scratchFilePath <- fst <$> Cli.expectLatestFile
                          liftIO $ env.writeSource (Text.pack scratchFilePath) (Pretty.toPlain 80 prettyUnisonFile) True
                          done Output.UpdateTypecheckingFailure
                        else do
                          uniqueTypeGuidsByName <-
                            Cli.runTransaction (makeUniqueTypeGuids (BiMultimap.range unconflictedView.defns.types))

                          (_updateBranchId, _updateBranchName) <-
                            HandleInput.Branch.createBranch
                              ("update " <> into @Text (ProjectAndBranch pp.project.name pp.branch.name))
                              ( HandleInput.Branch.CreateFrom'Update
                                  (pp.branch, Branch.headHash currentBranch, uniqueTypeGuidsByName)
                                  nextNamespace
                              )
                              pp.project
                              ( ProjectUtils.findTemporaryBranchName
                                  projectId
                                  ( ("update-" <> projectBranchNameToValidProjectBranchNameText pp.branch.name)
                                      & TextBuilder.toText
                                      & unsafeFrom @Text
                                  )
                              )
                          scratchFilePath <- fst <$> Cli.expectLatestFile
                          #latestFile ?= (scratchFilePath, True)
                          liftIO $ env.writeSource (Text.pack scratchFilePath) (Pretty.toPlain 80 prettyUnisonFile) True
                          done (Output.UpdateTypecheckingFailure2 scratchFilePath pp.branch.name)
                    else do
                      scratchFilePath <- fst <$> Cli.expectLatestFile
                      #latestFile ?= (scratchFilePath, True)
                      liftIO $ env.writeSource (Text.pack scratchFilePath) (Pretty.toPlain 80 prettyUnisonFile) True
                      done Output.UpdateTypecheckingFailure

              respondRegion (Output.Literal (Pretty.wrap "Everything typechecks, so I'm saving the results..."))

              pure secondTuf

        path <- Cli.getCurrentProjectPath
        branchUpdates <-
          Cli.runTransactionWithRollback \forall void. Output -> Transaction void
abort -> do
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
(Var v, Show a) =>
Codebase m v a -> TypecheckedUnisonFile v a -> Transaction ()
Codebase.addDefsToCodebase Env
env.codebase TypecheckedUnisonFile Symbol Ann
secondTuf
            (forall void. Output -> Transaction void)
-> (Name -> Either Output (Maybe [Name]))
-> TypecheckedUnisonFile Symbol Ann
-> Transaction [(Path, Branch0 IO -> Branch0 IO)]
forall (m :: * -> *).
(forall void. Output -> Transaction void)
-> (Name -> Either Output (Maybe [Name]))
-> TypecheckedUnisonFile Symbol Ann
-> Transaction [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchUpdates
              Output -> Transaction void
forall void. Output -> Transaction void
abort
              (\Name
typeName -> Maybe [Name] -> Either Output (Maybe [Name])
forall a b. b -> Either a b
Right (Name -> Map Name [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
typeName DeclNameLookup
declNameLookup.declToConstructors))
              TypecheckedUnisonFile Symbol Ann
secondTuf
        Cli.stepAt "update" (path, Branch.batchUpdates branchUpdates)
        #latestTypecheckedFile .= Nothing

        -- Special case: we are running a successful `update` on a merge/update/upgrade branch that has a parent (such
        -- branches won't have a parent only if the parent has been deleted for some reason).
        case (pp.branch.isUpdate || pp.branch.isUpgrade || pp.branch.isMerge, pp.branch.parentBranchId) of
          (Bool
True, Just ProjectBranchId
parentBranchId) -> do
            -- Switch to the parent branch
            parentBranch <-
              Transaction ProjectBranch -> Cli ProjectBranch
forall a. Transaction a -> Cli a
Cli.runTransaction do
                ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Queries.expectProjectBranch ProjectId
projectId ProjectBranchId
parentBranchId
            Cli.switchProject (ProjectAndBranch projectId parentBranch.branchId)

            -- Merge into the parent branch. This isn't guaranteed to succeed, but it probably will.

            Merge.doMergeLocalBranch
              Merge.TwoWay
                { alice = ProjectAndBranch pp.project parentBranch,
                  bob = ProjectAndBranch pp.project pp.branch
                }

            -- If the merge succeeded, delete the current branch. We may want to try to delete it even if the merge
            -- fails, because otherwise the user will have to manually clean it up, which isn't as nice as a successful
            -- `update` on an update branch. However, it's very likely that the merge is simply a fast-forward.

            DeleteBranch.doDeleteProjectBranch (ProjectAndBranch pp.project pp.branch)
          (Bool, Maybe ProjectBranchId)
_ -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        pure Output.Success

  Cli.respond finalOutput

makePrettyUnisonFile :: Pretty ColorText -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText
makePrettyUnisonFile :: Pretty ColorText
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
makePrettyUnisonFile Pretty ColorText
originalFile DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents =
  Pretty ColorText
originalFile
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- The definitions below no longer typecheck with the changes above."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- Please fix the errors and try `update` again."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Map Name (Pretty ColorText) -> Pretty ColorText
renderDefns DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents.types
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Map Name (Pretty ColorText) -> Pretty ColorText
renderDefns DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents.terms
  where
    renderDefns :: Map Name (Pretty ColorText) -> Pretty ColorText
    renderDefns :: Map Name (Pretty ColorText) -> Pretty ColorText
renderDefns =
      ((Name, Pretty ColorText) -> Pretty ColorText)
-> [(Name, Pretty ColorText)] -> Pretty ColorText
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Name
_, Pretty ColorText
defn) -> Pretty ColorText
defn Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline)
        ([(Name, Pretty ColorText)] -> Pretty ColorText)
-> (Map Name (Pretty ColorText) -> [(Name, Pretty ColorText)])
-> Map Name (Pretty ColorText)
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Pretty ColorText) -> Name)
-> [(Name, Pretty ColorText)] -> [(Name, Pretty ColorText)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Name, Pretty ColorText) -> Name
forall a b. (a, b) -> a
fst
        ([(Name, Pretty ColorText)] -> [(Name, Pretty ColorText)])
-> (Map Name (Pretty ColorText) -> [(Name, Pretty ColorText)])
-> Map Name (Pretty ColorText)
-> [(Name, Pretty ColorText)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name (Pretty ColorText) -> [(Name, Pretty ColorText)]
forall k a. Map k a -> [(k, a)]
Map.toList

-- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing
-- along to `batchUpdates` or some "step at" combinator) that corresponds to using all of the contents of @file@.
-- `getConstructors` returns the full constructor names of a decl, e.g. "Maybe" -> ["Maybe.Nothing", "Maybe.Just"]
--
-- For example, if the file contains
--
--     foo.bar.baz = <#foo>
--
-- then the returned updates will look like
--
--     [ ("foo.bar", insert-term("baz",<#foo>)) ]
typecheckedUnisonFileToBranchUpdates ::
  (forall void. Output -> Transaction void) ->
  -- | Returns 'Nothing' if the decl isn't in namesExcludingLibdeps,
  -- in which case we know the decl is new and do not need to generate
  -- delete actions for it.
  (Name -> Either Output (Maybe [Name])) ->
  TypecheckedUnisonFile Symbol Ann ->
  Transaction [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchUpdates :: forall (m :: * -> *).
(forall void. Output -> Transaction void)
-> (Name -> Either Output (Maybe [Name]))
-> TypecheckedUnisonFile Symbol Ann
-> Transaction [(Path, Branch0 m -> Branch0 m)]
typecheckedUnisonFileToBranchUpdates forall void. Output -> Transaction void
abort Name -> Either Output (Maybe [Name])
getConstructors TypecheckedUnisonFile Symbol Ann
tuf = do
  declUpdates <- (forall void. Output -> Transaction void)
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
(forall void. Output -> Transaction void)
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates Output -> Transaction void
forall void. Output -> Transaction void
abort
  pure $ declUpdates ++ termUpdates
  where
    makeDeclUpdates :: forall m. (forall void. Output -> Transaction void) -> Transaction [(Path, Branch0 m -> Branch0 m)]
    makeDeclUpdates :: forall (m :: * -> *).
(forall void. Output -> Transaction void)
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates forall void. Output -> Transaction void
abort = do
      dataDeclUpdates <- ((Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
 -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
Monoid.foldMapM (Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
 -> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))])
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ 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)
      effectDeclUpdates <- Monoid.foldMapM makeEffectDeclUpdates (Map.toList $ UF.effectDeclarationsId' tuf)
      pure $ dataDeclUpdates <> effectDeclUpdates
      where
        makeDataDeclUpdates :: (Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann
dataDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
dataDecl))
        makeEffectDeclUpdates :: (Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann
effectDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left EffectDeclaration Symbol Ann
effectDecl))

        makeDeclUpdates :: (Symbol, (TypeReferenceId, Decl Symbol Ann)) -> Transaction [(Path, Branch0 m -> Branch0 m)]
        makeDeclUpdates :: (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, Decl Symbol Ann
decl)) = do
          -- some decls will be deleted, we want to delete their
          -- constructors as well
          deleteConstructorActions <-
            ( [(Path, Branch0 m -> Branch0 m)]
-> ([Name] -> [(Path, Branch0 m -> Branch0 m)])
-> Maybe [Name]
-> [(Path, Branch0 m -> Branch0 m)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Name -> (Path, Branch0 m -> Branch0 m))
-> [Name] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map (Split Path -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTermName (Split Path -> (Path, Branch0 m -> Branch0 m))
-> (Name -> Split Path) -> Name -> (Path, Branch0 m -> Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split Path
Path.splitFromName))
                (Maybe [Name] -> [(Path, Branch0 m -> Branch0 m)])
-> Either Output (Maybe [Name])
-> Either Output [(Path, Branch0 m -> Branch0 m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Either Output (Maybe [Name])
getConstructors (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
symbol)
            )
              Either Output [(Path, Branch0 m -> Branch0 m)]
-> (Either Output [(Path, Branch0 m -> Branch0 m)]
    -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall a b. a -> (a -> b) -> b
& (Output -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> Either Output [(Path, Branch0 m -> Branch0 m)]
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft Output -> Transaction [(Path, Branch0 m -> Branch0 m)]
forall void. Output -> Transaction void
abort
          let deleteTypeAction = Split Path -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTypeName Split Path
split
              split = Symbol -> Split Path
splitVar Symbol
symbol
              insertTypeAction = Split Path -> Reference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Reference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split Path
split (TermReferenceId -> Reference
Reference.fromId TermReferenceId
typeRefId)
              insertTypeConstructorActions =
                let referentIdsWithNames :: [(Symbol, Id)]
referentIdsWithNames = [Symbol] -> [Id] -> [(Symbol, Id)]
forall a b. [a] -> [b] -> [(a, b)]
zip (DataDeclaration Symbol Ann -> [Symbol]
forall v a. DataDeclaration v a -> [v]
Decl.constructorVars (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
Decl.asDataDecl Decl Symbol Ann
decl)) (TermReferenceId -> Decl Symbol Ann -> [Id]
forall v a. TermReferenceId -> Decl v a -> [Id]
Decl.declConstructorReferents TermReferenceId
typeRefId Decl Symbol Ann
decl)
                 in ((Symbol, Id) -> (Path, Branch0 m -> Branch0 m))
-> [(Symbol, Id)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map
                      ( \(Symbol
sym, Id
rid) ->
                          let splitConName :: Split Path
splitConName = Symbol -> Split Path
splitVar Symbol
sym
                           in Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Path
splitConName (TermReferenceId -> Reference
Reference.fromId (TermReferenceId -> Reference) -> Id -> Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id
rid)
                      )
                      [(Symbol, Id)]
referentIdsWithNames
              deleteStuff = (Path, Branch0 m -> Branch0 m)
deleteTypeAction (Path, Branch0 m -> Branch0 m)
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. a -> [a] -> [a]
: [(Path, Branch0 m -> Branch0 m)]
deleteConstructorActions
              addStuff = (Path, Branch0 m -> Branch0 m)
insertTypeAction (Path, Branch0 m -> Branch0 m)
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. a -> [a] -> [a]
: [(Path, Branch0 m -> Branch0 m)]
insertTypeConstructorActions
          pure $ deleteStuff ++ addStuff

    termUpdates :: [(Path, Branch0 m -> Branch0 m)]
    termUpdates :: forall (m :: * -> *). [(Path, Branch0 m -> Branch0 m)]
termUpdates =
      TypecheckedUnisonFile Symbol Ann
tuf
        TypecheckedUnisonFile Symbol Ann
-> (TypecheckedUnisonFile Symbol Ann
    -> Map
         Symbol
         (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId
        Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> (Map
      Symbol
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann)
    -> [(Symbol,
         (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))])
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))]
-> ([(Symbol,
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann))]
    -> [(Path, Branch0 m -> Branch0 m)])
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. a -> (a -> b) -> b
& ((Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
-> [(Path, Branch0 m -> Branch0 m)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Symbol
var, (Ann
_, TermReferenceId
ref, Maybe FilePath
wk, Term Symbol Ann
_, Type Symbol Ann
_)) ->
          if Maybe FilePath -> Bool
WK.watchKindShouldBeStoredInDatabase Maybe FilePath
wk
            then
              let split :: Split Path
split = Symbol -> Split Path
splitVar Symbol
var
               in [ Split Path -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTermName Split Path
split,
                    Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Path
split (TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
ref)
                  ]
            else []

    splitVar :: Symbol -> Path.Split Path
    splitVar :: Symbol -> Split Path
splitVar = Name -> Split Path
Path.splitFromName (Name -> Split Path) -> (Symbol -> Name) -> Symbol -> Split Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar

-- The big picture behind PPE building, though there are many details:
--
--   * We are updating old references to new references by rendering old references as names that are then parsed
--     back to resolve to new references (the world's weirdest implementation of AST substitution).
--
--   * We have to render names that refer to definitions in the file with a different suffixification strategy
--     (namely, "suffixify by name") than names that refer to things in the codebase.
--
--     This is because you *may* refer to aliases that share a suffix by that suffix for definitions in the
--     codebase, but not in the file.
--
--     For example, the following file will fail to parse:
--
--       one.foo = 10
--       two.foo = 10
--       hey = foo + foo -- "Which foo do you mean? There are two."
--
--     However, the following file will not fail to parse, if `one.foo` and `two.foo` are aliases in the codebase:
--
--       hey = foo + foo
makePPE ::
  Int ->
  Names ->
  Names ->
  DefnsF (Map Name) TermReferenceId TypeReferenceId ->
  PrettyPrintEnvDecl
makePPE :: Int
-> Names
-> Names
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> PrettyPrintEnvDecl
makePPE Int
hashLen Names
namespaceNames Names
initialFileNames DefnsF (Map Name) TermReferenceId TermReferenceId
dependents =
  [PrettyPrintEnvDecl] -> PrettyPrintEnvDecl
PPED.leftBiased
    [ let names :: Names
names = Names
initialFileNames Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> DefnsF (Map Name) TermReferenceId TermReferenceId -> Names
Names.fromUnconflictedReferenceIds DefnsF (Map Name) TermReferenceId TermReferenceId
dependents
       in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Names -> Namer
PPE.namer Names
names) (Names -> Suffixifier
PPE.suffixifyByName (Names -> Names -> Names
Names.shadowing Names
names Names
namespaceNames)),
      Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
        (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
namespaceNames)
        -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the
        -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be
        -- ambiguous in the context of namespace + file names.
        --
        -- So, we use `shadowing`, which starts with the LHS names (the namespace), and adds to it names from the
        -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS.
        (Names -> Suffixifier
PPE.suffixifyByHash (Names -> Names -> Names
Names.shadowing Names
namespaceNames Names
initialFileNames))
    ]