module Unison.Codebase.Editor.HandleInput.Update
  ( handleUpdate,
    doSlurpAdds,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty qualified as NESet
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.ABT qualified as ABT
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Input
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.Propagate qualified as Propagate
import Unison.Codebase.Editor.Slurp qualified as Slurp
import Unison.Codebase.Editor.SlurpComponent (SlurpComponent (..))
import Unison.Codebase.Editor.SlurpComponent qualified as SC
import Unison.Codebase.Editor.SlurpResult (SlurpResult (..))
import Unison.Codebase.Editor.SlurpResult qualified as Slurp
import Unison.Codebase.Patch (Patch (..))
import Unison.Codebase.Patch qualified as Patch
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.TermEdit qualified as TermEdit
import Unison.Codebase.TypeEdit qualified as TypeEdit
import Unison.DataDeclaration (Decl)
import Unison.FileParsers qualified as FileParsers
import Unison.Hash (Hash)
import Unison.Name (Name)
import Unison.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 qualified as PPE hiding (biasTo)
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name (toVar, unsafeParseVar)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Map qualified as Map (remap, upsert)
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Relation qualified as R
import Unison.Util.Set qualified as Set
import Unison.Var qualified as Var
import Unison.WatchKind (WatchKind)

-- | Handle an @update@ command.
handleUpdate :: Input -> OptionalPatch -> Set Name -> Cli ()
handleUpdate :: Input -> OptionalPatch -> Set Name -> Cli ()
handleUpdate Input
input OptionalPatch
optionalPatch Set Name
requestedNames = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectPath
ppRoot <- ProjectPath -> ProjectPath
PP.toRoot (ProjectPath -> ProjectPath) -> Cli ProjectPath -> Cli ProjectPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
Cli.getCurrentProjectPath
  Absolute
currentPathAbs <- Cli Absolute
Cli.getCurrentPath
  let patchPath :: Maybe Split'
patchPath =
        case OptionalPatch
optionalPatch of
          OptionalPatch
NoPatch -> Maybe Split'
forall a. Maybe a
Nothing
          OptionalPatch
DefaultPatch -> Split' -> Maybe Split'
forall a. a -> Maybe a
Just Split'
Cli.defaultPatchPath
          UsePatch Split'
p -> Split' -> Maybe Split'
forall a. a -> Maybe a
Just Split'
p
  Names
currentCodebaseNames <- Cli Names
Cli.currentNames
  SlurpResult
sr <- Set Name -> Names -> Cli SlurpResult
getSlurpResultForUpdate Set Name
requestedNames Names
currentCodebaseNames
  let addsAndUpdates :: SlurpComponent
      addsAndUpdates :: SlurpComponent
addsAndUpdates = SlurpResult -> SlurpComponent
Slurp.updates SlurpResult
sr SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpResult -> SlurpComponent
Slurp.adds SlurpResult
sr
      fileNames :: Names
      fileNames :: Names
fileNames = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
sr)
      -- todo: display some error if typeEdits or termEdits itself contains a loop
      typeEdits :: [(Name, Reference, Reference)]
      typeEdits :: [(Name, TermReference, TermReference)]
typeEdits = do
        Symbol
v <- Set Symbol -> [Symbol]
forall a. Set a -> [a]
Set.toList (SlurpComponent -> Set Symbol
SC.types (SlurpResult -> SlurpComponent
updates SlurpResult
sr))
        let n :: Name
n = Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v
        let oldRefs0 :: Set TermReference
oldRefs0 = Names -> Name -> Set TermReference
Names.typesNamed Names
currentCodebaseNames Name
n
        let newRefs :: Set TermReference
newRefs = Names -> Name -> Set TermReference
Names.typesNamed Names
fileNames Name
n
        case (,) (NESet TermReference
 -> TermReference -> (NESet TermReference, TermReference))
-> Maybe (NESet TermReference)
-> Maybe (TermReference -> (NESet TermReference, TermReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TermReference -> Maybe (NESet TermReference)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet Set TermReference
oldRefs0 Maybe (TermReference -> (NESet TermReference, TermReference))
-> Maybe TermReference
-> Maybe (NESet TermReference, TermReference)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set TermReference -> Maybe TermReference
forall a. Set a -> Maybe a
Set.asSingleton Set TermReference
newRefs of
          Maybe (NESet TermReference, TermReference)
Nothing -> WatchKind -> [(Name, TermReference, TermReference)]
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> WatchKind -> WatchKind
reportBug WatchKind
"E722145" (WatchKind
"bad (old,new) names: " WatchKind -> WatchKind -> WatchKind
forall a. [a] -> [a] -> [a]
++ (Set TermReference, Set TermReference) -> WatchKind
forall a. Show a => a -> WatchKind
show (Set TermReference
oldRefs0, Set TermReference
newRefs)))
          Just (NESet TermReference
oldRefs, TermReference
newRef) -> do
            TermReference
oldRef <- NESet TermReference -> [TermReference]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NESet TermReference
oldRefs
            [(Name
n, TermReference
oldRef, TermReference
newRef)]
      hashTerms :: Map Reference (Type Symbol Ann)
      hashTerms :: Map TermReference (Type Symbol Ann)
hashTerms = [(TermReference, Type Symbol Ann)]
-> Map TermReference (Type Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Map Symbol (TermReference, Type Symbol Ann)
-> [(TermReference, Type Symbol Ann)]
forall a. Map Symbol a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map Symbol (TermReference, Type Symbol Ann)
hashTerms0)
        where
          hashTerms0 :: Map Symbol (TermReference, Type Symbol Ann)
hashTerms0 = (\(Ann
_ann, TermReference
r, Maybe WatchKind
_wk, Term Symbol Ann
_tm, Type Symbol Ann
typ) -> (TermReference
r, Type Symbol Ann
typ)) ((Ann, TermReference, Maybe WatchKind, Term Symbol Ann,
  Type Symbol Ann)
 -> (TermReference, Type Symbol Ann))
-> Map
     Symbol
     (Ann, TermReference, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
-> Map Symbol (TermReference, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReference, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReference, Maybe WatchKind, Term v a, Type v a)
UF.hashTerms (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
sr)
      termEdits :: [(Name, Reference, Reference)]
      termEdits :: [(Name, TermReference, TermReference)]
termEdits = do
        Symbol
v <- Set Symbol -> [Symbol]
forall a. Set a -> [a]
Set.toList (SlurpComponent -> Set Symbol
SC.terms (SlurpResult -> SlurpComponent
updates SlurpResult
sr))
        let n :: Name
n = Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v
        let oldRefs0 :: Set TermReference
oldRefs0 = Names -> Name -> Set TermReference
Names.refTermsNamed Names
currentCodebaseNames Name
n
        let newRefs :: Set TermReference
newRefs = Names -> Name -> Set TermReference
Names.refTermsNamed Names
fileNames Name
n
        case (,) (NESet TermReference
 -> TermReference -> (NESet TermReference, TermReference))
-> Maybe (NESet TermReference)
-> Maybe (TermReference -> (NESet TermReference, TermReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TermReference -> Maybe (NESet TermReference)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet Set TermReference
oldRefs0 Maybe (TermReference -> (NESet TermReference, TermReference))
-> Maybe TermReference
-> Maybe (NESet TermReference, TermReference)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set TermReference -> Maybe TermReference
forall a. Set a -> Maybe a
Set.asSingleton Set TermReference
newRefs of
          Maybe (NESet TermReference, TermReference)
Nothing -> WatchKind -> [(Name, TermReference, TermReference)]
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> WatchKind -> WatchKind
reportBug WatchKind
"E936103" (WatchKind
"bad (old,new) names: " WatchKind -> WatchKind -> WatchKind
forall a. [a] -> [a] -> [a]
++ (Set TermReference, Set TermReference) -> WatchKind
forall a. Show a => a -> WatchKind
show (Set TermReference
oldRefs0, Set TermReference
newRefs)))
          Just (NESet TermReference
oldRefs, TermReference
newRef) -> do
            TermReference
oldRef <- NESet TermReference -> [TermReference]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NESet TermReference
oldRefs
            [(Name
n, TermReference
oldRef, TermReference
newRef)]
      termDeprecations :: [(Name, Referent)]
      termDeprecations :: [(Name, Referent)]
termDeprecations =
        [ (Name
n, Referent
r)
          | (Name
_, TermReference
oldTypeRef, TermReference
_) <- [(Name, TermReference, TermReference)]
typeEdits,
            (Name
n, Referent
r) <- TermReference -> Names -> [(Name, Referent)]
Names.constructorsForType TermReference
oldTypeRef Names
currentCodebaseNames
        ]
  Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
patchOps <- Maybe Split'
-> (Split' -> Cli (Patch, Branch0 IO -> IO (Branch0 IO), Absolute))
-> Cli (Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe Split'
patchPath \Split'
patchPath -> do
    Patch
ye'ol'Patch <- Split' -> Cli Patch
Cli.getPatchAt Split'
patchPath
    -- If `uf` updates a -> a', we want to replace all (a0 -> a) in patch
    -- with (a0 -> a') in patch'.
    -- So for all (a0 -> a) in patch, for all (a -> a') in `uf`,
    -- we must know the type of a0, a, a'.
    let -- we need:
        -- all of the `old` references from the `new` edits,
        -- plus all of the `old` references for edits from patch we're replacing
        collectOldForTyping :: [(Reference, Reference)] -> Patch -> Set Reference
        collectOldForTyping :: [(TermReference, TermReference)] -> Patch -> Set TermReference
collectOldForTyping [(TermReference, TermReference)]
new Patch
old = (Set TermReference
 -> (TermReference, TermReference) -> Set TermReference)
-> Set TermReference
-> [(TermReference, TermReference)]
-> Set TermReference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set TermReference
-> (TermReference, TermReference) -> Set TermReference
forall {a} {b}. Ord a => Set a -> (a, b) -> Set a
f Set TermReference
forall a. Monoid a => a
mempty ([(TermReference, TermReference)]
new [(TermReference, TermReference)]
-> [(TermReference, TermReference)]
-> [(TermReference, TermReference)]
forall a. [a] -> [a] -> [a]
++ [(TermReference, TermReference)]
fromOld)
          where
            f :: Set a -> (a, b) -> Set a
f Set a
acc (a
r, b
_r') = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
r Set a
acc
            newLHS :: Set TermReference
newLHS = [TermReference] -> Set TermReference
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReference] -> Set TermReference)
-> ([(TermReference, TermReference)] -> [TermReference])
-> [(TermReference, TermReference)]
-> Set TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TermReference, TermReference) -> TermReference)
-> [(TermReference, TermReference)] -> [TermReference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TermReference, TermReference) -> TermReference
forall a b. (a, b) -> a
fst ([(TermReference, TermReference)] -> Set TermReference)
-> [(TermReference, TermReference)] -> Set TermReference
forall a b. (a -> b) -> a -> b
$ [(TermReference, TermReference)]
new
            fromOld :: [(Reference, Reference)]
            fromOld :: [(TermReference, TermReference)]
fromOld =
              [ (TermReference
r, TermReference
r') | (TermReference
r, TermEdit.Replace TermReference
r' Typing
_) <- Relation TermReference TermEdit -> [(TermReference, TermEdit)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation TermReference TermEdit -> [(TermReference, TermEdit)])
-> (Patch -> Relation TermReference TermEdit)
-> Patch
-> [(TermReference, TermEdit)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch -> Relation TermReference TermEdit
Patch._termEdits (Patch -> [(TermReference, TermEdit)])
-> Patch -> [(TermReference, TermEdit)]
forall a b. (a -> b) -> a -> b
$ Patch
old, TermReference -> Set TermReference -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TermReference
r' Set TermReference
newLHS
              ]
        neededTypes :: Set TermReference
neededTypes = [(TermReference, TermReference)] -> Patch -> Set TermReference
collectOldForTyping (((Name, TermReference, TermReference)
 -> (TermReference, TermReference))
-> [(Name, TermReference, TermReference)]
-> [(TermReference, TermReference)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
_, TermReference
old, TermReference
new) -> (TermReference
old, TermReference
new)) [(Name, TermReference, TermReference)]
termEdits) Patch
ye'ol'Patch

    Map TermReference (Type Symbol Ann)
allTypes :: Map Reference (Type v Ann) <-
      (IO (Map TermReference (Type Symbol Ann))
-> Cli (Map TermReference (Type Symbol Ann))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map TermReference (Type Symbol Ann))
 -> Cli (Map TermReference (Type Symbol Ann)))
-> (Transaction (Map TermReference (Type Symbol Ann))
    -> IO (Map TermReference (Type Symbol Ann)))
-> Transaction (Map TermReference (Type Symbol Ann))
-> Cli (Map TermReference (Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction (Map TermReference (Type Symbol Ann))
-> IO (Map TermReference (Type Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase) do
        ([(TermReference, Type Symbol Ann)]
 -> Map TermReference (Type Symbol Ann))
-> Transaction [(TermReference, Type Symbol Ann)]
-> Transaction (Map TermReference (Type Symbol Ann))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TermReference, Type Symbol Ann)]
-> Map TermReference (Type Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Transaction [(TermReference, Type Symbol Ann)]
 -> Transaction (Map TermReference (Type Symbol Ann)))
-> ((TermReference -> Transaction (TermReference, Type Symbol Ann))
    -> Transaction [(TermReference, Type Symbol Ann)])
-> (TermReference -> Transaction (TermReference, Type Symbol Ann))
-> Transaction (Map TermReference (Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TermReference]
-> (TermReference -> Transaction (TermReference, Type Symbol Ann))
-> Transaction [(TermReference, Type Symbol Ann)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set TermReference -> [TermReference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TermReference
neededTypes) ((TermReference -> Transaction (TermReference, Type Symbol Ann))
 -> Transaction (Map TermReference (Type Symbol Ann)))
-> (TermReference -> Transaction (TermReference, Type Symbol Ann))
-> Transaction (Map TermReference (Type Symbol Ann))
forall a b. (a -> b) -> a -> b
$ \TermReference
r ->
          (TermReference
r,) (Type Symbol Ann -> (TermReference, Type Symbol Ann))
-> (Maybe (Type Symbol Ann) -> Type Symbol Ann)
-> Maybe (Type Symbol Ann)
-> (TermReference, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Symbol Ann -> Maybe (Type Symbol Ann) -> Type Symbol Ann
forall a. a -> Maybe a -> a
fromMaybe (Ann -> Text -> Type Symbol Ann
forall v a. Ord v => a -> Text -> Type v a
Type.builtin Ann
External Text
"unknown type")
            (Maybe (Type Symbol Ann) -> (TermReference, Type Symbol Ann))
-> Transaction (Maybe (Type Symbol Ann))
-> Transaction (TermReference, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> TermReference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> TermReference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase IO Symbol Ann
codebase TermReference
r

    let typing :: TermReference -> TermReference -> Typing
typing TermReference
r1 TermReference
r2 = case (TermReference
-> Map TermReference (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReference
r1 Map TermReference (Type Symbol Ann)
allTypes, TermReference
-> Map TermReference (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReference
r2 Map TermReference (Type Symbol Ann)
hashTerms) of
          (Just Type Symbol Ann
t1, Just Type Symbol Ann
t2)
            | Type Symbol Ann -> Type Symbol Ann -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type Symbol Ann
t1 Type Symbol Ann
t2 -> Typing
TermEdit.Same
            | Type Symbol Ann -> Type Symbol Ann -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isSubtype Type Symbol Ann
t1 Type Symbol Ann
t2 -> Typing
TermEdit.Subtype
            | Bool
otherwise -> Typing
TermEdit.Different
          (Maybe (Type Symbol Ann), Maybe (Type Symbol Ann))
e ->
            WatchKind -> Typing
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> Typing) -> WatchKind -> Typing
forall a b. (a -> b) -> a -> b
$
              WatchKind
"compiler bug: typing map not constructed properly\n"
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> WatchKind
"typing "
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> TermReference -> WatchKind
forall a. Show a => a -> WatchKind
show TermReference
r1
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> WatchKind
" "
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> TermReference -> WatchKind
forall a. Show a => a -> WatchKind
show TermReference
r2
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> WatchKind
" : "
                WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> (Maybe (Type Symbol Ann), Maybe (Type Symbol Ann)) -> WatchKind
forall a. Show a => a -> WatchKind
show (Maybe (Type Symbol Ann), Maybe (Type Symbol Ann))
e

        updatePatch :: Patch -> Patch
        updatePatch :: Patch -> Patch
updatePatch Patch
p = (Patch -> (Name, TermReference, TermReference) -> Patch)
-> Patch -> [(Name, TermReference, TermReference)] -> Patch
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Patch -> (Name, TermReference, TermReference) -> Patch
step2 Patch
p' [(Name, TermReference, TermReference)]
termEdits
          where
            p' :: Patch
p' = (Patch -> (Name, TermReference, TermReference) -> Patch)
-> Patch -> [(Name, TermReference, TermReference)] -> Patch
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Patch -> (Name, TermReference, TermReference) -> Patch
forall {a}. Patch -> (a, TermReference, TermReference) -> Patch
step1 Patch
p [(Name, TermReference, TermReference)]
typeEdits
            step1 :: Patch -> (a, TermReference, TermReference) -> Patch
step1 Patch
p (a
_, TermReference
r, TermReference
r') = TermReference -> TypeEdit -> Patch -> Patch
Patch.updateType TermReference
r (TermReference -> TypeEdit
TypeEdit.Replace TermReference
r') Patch
p
            step2 :: Patch -> (Name, TermReference, TermReference) -> Patch
step2 Patch
p (Name
_, TermReference
r, TermReference
r') = (TermReference -> TermReference -> Typing)
-> TermReference -> TermEdit -> Patch -> Patch
Patch.updateTerm TermReference -> TermReference -> Typing
typing TermReference
r (TermReference -> Typing -> TermEdit
TermEdit.Replace TermReference
r' (TermReference -> TermReference -> Typing
typing TermReference
r TermReference
r')) Patch
p
        (Absolute
p, NameSegment
seg) = Absolute -> Split' -> (Absolute, NameSegment)
forall a. Absolute -> (Path', a) -> (Absolute, a)
Path.toAbsoluteSplit Absolute
currentPathAbs Split'
patchPath
        updatePatches :: (Monad m) => Branch0 m -> m (Branch0 m)
        updatePatches :: forall (m :: * -> *). Monad m => Branch0 m -> m (Branch0 m)
updatePatches = NameSegment -> (Patch -> Patch) -> Branch0 m -> m (Branch0 m)
forall (m :: * -> *).
Monad m =>
NameSegment -> (Patch -> Patch) -> Branch0 m -> m (Branch0 m)
Branch.modifyPatches NameSegment
seg Patch -> Patch
updatePatch
    (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
-> Cli (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Patch -> Patch
updatePatch Patch
ye'ol'Patch, Branch0 IO -> IO (Branch0 IO)
forall (m :: * -> *). Monad m => Branch0 m -> m (Branch0 m)
updatePatches, Absolute
p)

  Branch IO
updatedProjectRootBranch <-
    if SlurpResult -> Bool
Slurp.hasAddsOrUpdates SlurpResult
sr
      then do
        -- First add the new definitions to the codebase
        Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction
          (Transaction () -> Cli ())
-> (TypecheckedUnisonFile Symbol Ann -> Transaction ())
-> TypecheckedUnisonFile Symbol Ann
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Codebase IO Symbol Ann
codebase
          (TypecheckedUnisonFile Symbol Ann -> Transaction ())
-> (TypecheckedUnisonFile Symbol Ann
    -> TypecheckedUnisonFile Symbol Ann)
-> TypecheckedUnisonFile Symbol Ann
-> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlurpResult
-> TypecheckedUnisonFile Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
Slurp.filterUnisonFile SlurpResult
sr
          (TypecheckedUnisonFile Symbol Ann -> Cli ())
-> TypecheckedUnisonFile Symbol Ann -> Cli ()
forall a b. (a -> b) -> a -> b
$ SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
sr
        Branch IO
projectRootBranch <- Cli (Branch IO)
Cli.getCurrentProjectRoot
        -- take a look at the `updates` from the SlurpResult
        -- and make a patch diff to record a replacement from the old to new references
        Branch IO
projectRootBranch
          Branch IO -> (Branch IO -> IO (Branch IO)) -> IO (Branch IO)
forall a b. a -> (a -> b) -> b
& [(Path, Branch0 IO -> IO (Branch0 IO))]
-> Branch IO -> IO (Branch IO)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
Branch.stepManyAtM
            ( [ ( Absolute -> Path
Path.unabsolute Absolute
currentPathAbs,
                  Branch0 IO -> IO (Branch0 IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 IO -> IO (Branch0 IO))
-> (Branch0 IO -> Branch0 IO) -> Branch0 IO -> IO (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, TermReference, TermReference)]
-> [(Name, TermReference, TermReference)]
-> [(Name, Referent)]
-> Branch0 IO
-> Branch0 IO
forall (m :: * -> *).
Monad m =>
[(Name, TermReference, TermReference)]
-> [(Name, TermReference, TermReference)]
-> [(Name, Referent)]
-> Branch0 m
-> Branch0 m
doSlurpUpdates [(Name, TermReference, TermReference)]
typeEdits [(Name, TermReference, TermReference)]
termEdits [(Name, Referent)]
termDeprecations
                ),
                ( Absolute -> Path
Path.unabsolute Absolute
currentPathAbs,
                  Branch0 IO -> IO (Branch0 IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 IO -> IO (Branch0 IO))
-> (Branch0 IO -> Branch0 IO) -> Branch0 IO -> IO (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 IO -> Branch0 IO
forall (m :: * -> *).
Monad m =>
SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 m -> Branch0 m
doSlurpAdds SlurpComponent
addsAndUpdates (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
sr)
                )
              ]
                [(Path, Branch0 IO -> IO (Branch0 IO))]
-> [(Path, Branch0 IO -> IO (Branch0 IO))]
-> [(Path, Branch0 IO -> IO (Branch0 IO))]
forall a. [a] -> [a] -> [a]
++ case Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
patchOps of
                  Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
Nothing -> []
                  Just (Patch
_, Branch0 IO -> IO (Branch0 IO)
update, Absolute
p) -> [(Absolute -> Path
Path.unabsolute Absolute
p, Branch0 IO -> IO (Branch0 IO)
update)]
            )
          IO (Branch IO)
-> (IO (Branch IO) -> Cli (Branch IO)) -> Cli (Branch IO)
forall a b. a -> (a -> b) -> b
& IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      else Cli (Branch IO)
Cli.getCurrentProjectRoot

  Branch IO
projectRootBranchWithPropagatedPatch <- case Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
patchOps of
    Maybe (Patch, Branch0 IO -> IO (Branch0 IO), Absolute)
Nothing -> Branch IO -> Cli (Branch IO)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch IO
updatedProjectRootBranch
    Just (Patch
updatedPatch, Branch0 IO -> IO (Branch0 IO)
_, Absolute
_) -> do
      -- Propagate the patch to the whole project.
      let scopePath :: Path
scopePath = Path
Path.empty
      Patch -> Path -> Branch IO -> Cli (Branch IO)
propagatePatch Patch
updatedPatch Path
scopePath Branch IO
updatedProjectRootBranch
  let description :: Text
description = case Maybe Split'
patchPath of
        Maybe Split'
Nothing -> Text
"update.nopatch"
        Just Split'
p ->
          Split'
p
            Split' -> (Split' -> Path') -> Path'
forall a b. a -> (a -> b) -> b
& Split' -> Path'
Path.unsplit'
            Path' -> (Path' -> Absolute) -> Absolute
forall a b. a -> (a -> b) -> b
& forall l r o. Resolve l r o => l -> r -> o
Path.resolve @_ @_ @Path.Absolute Absolute
currentPathAbs
            Absolute -> (Absolute -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Absolute -> Text
forall a. Show a => a -> Text
tShow
  Cli Bool -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli Bool -> Cli ()) -> Cli Bool -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
Cli.updateAt Text
description ProjectPath
ppRoot (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
projectRootBranchWithPropagatedPatch)
  let codebaseAndFileNames :: Names
codebaseAndFileNames = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
sr) (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Branch0 IO -> Names
forall a b. (a -> b) -> a -> b
$ Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
projectRootBranchWithPropagatedPatch)
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
codebaseAndFileNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
codebaseAndFileNames)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Input -> PrettyPrintEnv -> SlurpResult -> Output
SlurpOutput Input
input PrettyPrintEnv
suffixifiedPPE SlurpResult
sr

getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult
getSlurpResultForUpdate :: Set Name -> Names -> Cli SlurpResult
getSlurpResultForUpdate Set Name
requestedNames Names
slurpCheckNames = do
  let slurp :: TypecheckedUnisonFile Symbol Ann -> SlurpResult
      slurp :: TypecheckedUnisonFile Symbol Ann -> SlurpResult
slurp TypecheckedUnisonFile Symbol Ann
file =
        TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
file ((Name -> Symbol) -> Set Name -> Set Symbol
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Set Name
requestedNames) SlurpOp
Slurp.UpdateOp Names
slurpCheckNames

  let termRefToNames :: TermReferenceId -> Set Symbol
      termRefToNames :: TermReferenceId -> Set Symbol
termRefToNames =
        (Name -> Symbol) -> Set Name -> Set Symbol
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar (Set Name -> Set Symbol)
-> (TermReferenceId -> Set Name) -> TermReferenceId -> Set Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Referent -> Set Name
Names.namesForReferent Names
slurpCheckNames (Referent -> Set Name)
-> (TermReferenceId -> Referent) -> TermReferenceId -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermReferenceId -> Referent
Referent.fromTermReferenceId

  let nameToTermRefs :: Symbol -> Set TermReference
      nameToTermRefs :: Symbol -> Set TermReference
nameToTermRefs = Names -> Name -> Set TermReference
Names.refTermsNamed Names
slurpCheckNames (Name -> Set TermReference)
-> (Symbol -> Name) -> Symbol -> Set TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar

  SlurpResult
slurp1 <- do
    Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    TypecheckedUnisonFile Symbol Ann
unisonFile0 <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile

    -- Here, we identify whether there are any "implicit terms", which are terms that should be brought into the latest
    -- typechecked Unsion file and re-typechecked, which also re-discovers components.
    --
    -- The running example here will be one in which the current namespace already has the following terms stored.
    -- (For simplicity, we will ignore the limitation that mutually recursive definitions must be top-level arrows;
    -- pretend this is Haskell's let).
    --
    --   ping = pong + 1   (reference = #pingpong.ping)
    --   pong = ping + 2   (reference = #pingpong.pong)
    --   wham = pong + 3   (reference = #wham)
    --
    -- The user re-defines "ping" in their scratch file thus:
    --
    --   ping = wham + 4   (reference = #newping)
    --
    -- Note that, pre-update, we had two components [ping,pong] and [wham]. But after the update, since the new `ping`
    -- refers to the old `wham`, which refers to the old `pong`, which refers to the old `ping`, we really want to end
    -- up with a single component in the end, [ping,pong,wham].

    -- First, compute an initial slurp, which will identify the initial set of definitions we are updating ({"ping"}).
    -- Also, this will be the slurp that we fall back on, in case re-typechecking another Unison file with implicit
    -- terms in it fails.
    let slurp0 :: SlurpResult
slurp0 = TypecheckedUnisonFile Symbol Ann -> SlurpResult
slurp TypecheckedUnisonFile Symbol Ann
unisonFile0

    -- Grab some interim info out of the original slurp.
    --
    -- Running example:
    --
    --   "ping" => (#newping, Nothing, <#wham + 4>, <Nat>)
    let nameToInterimInfo :: Map Symbol (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)
        nameToInterimInfo :: Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
nameToInterimInfo =
          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 (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
slurp0)

    -- Get the set of names that are being updated.
    --
    -- Running example:
    --
    --   { "ping" }
    let namesBeingUpdated :: Set Symbol
        namesBeingUpdated :: Set Symbol
namesBeingUpdated =
          SlurpComponent -> Set Symbol
SC.terms (SlurpResult -> SlurpComponent
Slurp.updates SlurpResult
slurp0)

    -- Associate each such name with the set of old (already in the codebase) and new (in the scratch file) references
    -- that it's associated with.
    --
    -- Running example:
    --
    --   "ping" => ({ #pingpong.ping }, #newping)
    let updatedNameToRefs :: Map Symbol (Set TermReference, TermReferenceId)
        updatedNameToRefs :: Map Symbol (Set TermReference, TermReferenceId)
updatedNameToRefs =
          (Symbol -> (Set TermReference, TermReferenceId))
-> Set Symbol -> Map Symbol (Set TermReference, TermReferenceId)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet
            ( \Symbol
name ->
                case Symbol
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
-> Maybe
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
name Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
nameToInterimInfo of
                  Maybe
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
Nothing -> WatchKind -> (Set TermReference, TermReferenceId)
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> WatchKind -> WatchKind
reportBug WatchKind
"E798907" WatchKind
"no interim ref for name")
                  Just (Ann
_, TermReferenceId
interimRef, Maybe WatchKind
_, Term Symbol Ann
_, Type Symbol Ann
_) -> (Symbol -> Set TermReference
nameToTermRefs Symbol
name, TermReferenceId
interimRef)
            )
            Set Symbol
namesBeingUpdated

    -- Identify all of the implicit terms, which are:
    --
    --   - Both:
    --     - Either:
    --         - (A) A component-mate of a term that's being updated.
    --         - Both:
    --           - (B) A dependent of a term that's being updated.
    --           - (C) A dependency of the new term.
    --     - (D) Not being updated.
    --
    -- FIXME Additionally, we have one more temporary requirement.
    --
    --   - (E) The term has at least one unambiguous (unconflicted) name in the codebase.
    --
    -- This works around two fixable issues:
    --
    --   1. If the term has no names in the namespace, then we can't successfully put it into the Unison file anyway and
    --      forward it through the typecheck + slurp process, because slurping currently assumes that it can freely
    --      convert back-and-forth between vars and names.
    --
    --   2. If the term has only ambiguous/conflicted names, then putting one of them in the Unison file and proceeding
    --      to do an update would have the undesirable side-effect of resolving the conflict.
    --
    -- FIXME don't bother for type-changing updates
    --
    -- In our running example, the full list of component-mates (A) of the terms being updated is:
    --
    --   [ #pingpong.ping, #pingpong.pong ]
    --
    -- And because #pingpong.ping is being updated, due to (D), only #pingpong.pong remains.
    --
    -- Furthermore, #wham is both a dependent of #pingpong (B), and a dependency of #newping, so it too is an implicit
    -- term.
    --
    -- Running example:
    --
    --   #pingpong.pong => (<#pingpong.ping + 2>, "pong")
    --   #wham          => (<#pingpong.pong + 3>, "wham")
    Map TermReferenceId (Term Symbol Ann, Symbol)
implicitTerms :: Map TermReferenceId (Term Symbol Ann, Symbol) <-
      IO (Map TermReferenceId (Term Symbol Ann, Symbol))
-> Cli (Map TermReferenceId (Term Symbol Ann, Symbol))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
        Codebase IO Symbol Ann -> forall x. (Connection -> IO x) -> IO x
forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> m x) -> m x
Codebase.withConnection Codebase IO Symbol Ann
codebase \Connection
conn ->
          Connection
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
-> IO (Map TermReferenceId (Term Symbol Ann, Symbol))
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection -> Transaction a -> m a
Sqlite.runTransaction Connection
conn do
            -- Running example:
            --
            --   #pingpong => #newping
            let oldHashToInterimHash :: Map Hash Hash
                oldHashToInterimHash :: Map Hash Hash
oldHashToInterimHash =
                  Map Symbol (Set TermReference, TermReferenceId)
updatedNameToRefs Map Symbol (Set TermReference, TermReferenceId)
-> (Map Symbol (Set TermReference, TermReferenceId)
    -> Map Hash Hash)
-> Map Hash Hash
forall a b. a -> (a -> b) -> b
& ((Set TermReference, TermReferenceId) -> Map Hash Hash)
-> Map Symbol (Set TermReference, TermReferenceId) -> Map Hash Hash
forall m a. Monoid m => (a -> m) -> Map Symbol a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Set TermReference
oldRefs, TermReferenceId
interimRef) ->
                    let interimHash :: Hash
interimHash = TermReferenceId -> Hash
Reference.idToHash TermReferenceId
interimRef
                     in [(Hash, Hash)] -> Map Hash Hash
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Hash, Hash)] -> Map Hash Hash)
-> [(Hash, Hash)] -> Map Hash Hash
forall a b. (a -> b) -> a -> b
$
                          Set TermReference
oldRefs
                            Set TermReference
-> (Set TermReference -> [TermReference]) -> [TermReference]
forall a b. a -> (a -> b) -> b
& Set TermReference -> [TermReference]
forall a. Set a -> [a]
Set.toList
                            [TermReference] -> ([TermReference] -> [Hash]) -> [Hash]
forall a b. a -> (a -> b) -> b
& (TermReference -> Maybe Hash) -> [TermReference] -> [Hash]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe TermReference -> Maybe Hash
Reference.toHash
                            [Hash] -> ([Hash] -> [(Hash, Hash)]) -> [(Hash, Hash)]
forall a b. a -> (a -> b) -> b
& (Hash -> (Hash, Hash)) -> [Hash] -> [(Hash, Hash)]
forall a b. (a -> b) -> [a] -> [b]
map (,Hash
interimHash)

            let hashToImplicitTerms :: Hash -> Sqlite.Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
                hashToImplicitTerms :: Hash -> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
hashToImplicitTerms Hash
hash = do
                  -- Running example (for `oldHash` iteration):
                  --
                  --   [ (<#pingpong.pong + 1>, <Nat>),
                  --     (<#pingpong.ping + 2>, <Nat>)
                  --   ]
                  [(Term Symbol Ann, Type Symbol Ann)]
terms <- Codebase IO Symbol Ann
-> Hash -> Transaction [(Term Symbol Ann, Type Symbol Ann)]
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Hash -> Transaction [(Term v a, Type v a)]
Codebase.unsafeGetTermComponent Codebase IO Symbol Ann
codebase Hash
hash
                  let keep :: TermReferenceId -> Maybe Symbol
                      keep :: TermReferenceId -> Maybe Symbol
keep TermReferenceId
ref =
                        if Set Symbol -> Bool
notBeingUpdated Set Symbol
names
                          then (Symbol -> Bool) -> Set Symbol -> Maybe Symbol
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Foldable.find Symbol -> Bool
nameIsUnconflicted Set Symbol
names -- (E)
                          else Maybe Symbol
forall a. Maybe a
Nothing
                        where
                          -- (D) After getting the entire component of `oldHash`, which has at least one member being
                          -- updated, we want to keep only the members that are *not* being updated (i.e. those who have
                          -- no name that is being updated).
                          --
                          -- Running example, first time through (processing #pingpong.ping):
                          --
                          --   Set.disjoint { "ping" } { "ping" } is false, so don't add to the map.
                          --
                          -- Running example, second time through (processing #pingpong.pong):
                          --
                          --   Set.disjoint { "ping" } { "pong" } is true, so add
                          --   #pingpong.pong => (<#pingpong.ping + 2>, { "pong" })) to the map.
                          notBeingUpdated :: Set Symbol -> Bool
notBeingUpdated = Set Symbol -> Set Symbol -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint Set Symbol
namesBeingUpdated
                          nameIsUnconflicted :: Symbol -> Bool
nameIsUnconflicted Symbol
name = Set TermReference -> Int
forall a. Set a -> Int
Set.size (Symbol -> Set TermReference
nameToTermRefs Symbol
name) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                          names :: Set Symbol
names = TermReferenceId -> Set Symbol
termRefToNames TermReferenceId
ref
                  pure $
                    [(Term Symbol Ann, Type Symbol Ann)]
terms
                      -- Running example:
                      --
                      --   [ (#pingpong.ping, (<#pingpong.pong + 1>, <Nat>)),
                      --     (#pingpong.pong, (<#pingpong.ping + 2>, <Nat>))
                      --   ]
                      [(Term Symbol Ann, Type Symbol Ann)]
-> ([(Term Symbol Ann, Type Symbol Ann)]
    -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Hash
-> [(Term Symbol Ann, Type Symbol Ann)]
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall a. Hash -> [a] -> [(TermReferenceId, a)]
Reference.componentFor Hash
hash
                      [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> ([(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
    -> Map TermReferenceId (Term Symbol Ann, Symbol))
-> Map TermReferenceId (Term Symbol Ann, Symbol)
forall a b. a -> (a -> b) -> b
& (Map TermReferenceId (Term Symbol Ann, Symbol)
 -> (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Map TermReferenceId (Term Symbol Ann, Symbol))
-> Map TermReferenceId (Term Symbol Ann, Symbol)
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> Map TermReferenceId (Term Symbol Ann, Symbol)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                        ( \Map TermReferenceId (Term Symbol Ann, Symbol)
acc (TermReferenceId
ref, (Term Symbol Ann
term, Type Symbol Ann
_typ)) ->
                            case TermReferenceId -> Maybe Symbol
keep TermReferenceId
ref of
                              Maybe Symbol
Nothing -> Map TermReferenceId (Term Symbol Ann, Symbol)
acc
                              Just Symbol
name -> TermReferenceId
-> (Term Symbol Ann, Symbol)
-> Map TermReferenceId (Term Symbol Ann, Symbol)
-> Map TermReferenceId (Term Symbol Ann, Symbol)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TermReferenceId
ref (Term Symbol Ann
term, Symbol
name) Map TermReferenceId (Term Symbol Ann, Symbol)
acc
                        )
                        Map TermReferenceId (Term Symbol Ann, Symbol)
forall k a. Map k a
Map.empty

            if Map Hash Hash -> Bool
forall k a. Map k a -> Bool
Map.null Map Hash Hash
oldHashToInterimHash
              then Map TermReferenceId (Term Symbol Ann, Symbol)
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map TermReferenceId (Term Symbol Ann, Symbol)
forall k a. Map k a
Map.empty
              else do
                Transaction
  (Either
     (Map TermReferenceId (Term Symbol Ann, Symbol))
     (Map TermReferenceId (Term Symbol Ann, Symbol)))
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
forall a. Transaction (Either a a) -> Transaction a
Sqlite.savepoint do
                  -- Compute the actual interim decl/term components in the latest typechecked file. These aren't quite
                  -- given in the unison file structure itself - in the `topLevelComponents'` field we have the
                  -- components in some arbitrary order (I *think*), each tagged with its stringy name, and in the
                  -- `hashTermsId` field we have all of the individual terms organized by reference.
                  let interimDeclComponents :: [(Hash, [Decl Symbol Ann])]
                      interimDeclComponents :: [(Hash, [Decl Symbol Ann])]
interimDeclComponents =
                        (TypecheckedUnisonFile Symbol Ann
 -> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann))
-> (DataDeclaration Symbol Ann -> Decl Symbol Ann)
-> [(Hash, [Decl Symbol Ann])]
forall decl.
(TypecheckedUnisonFile Symbol Ann
 -> Map Symbol (TermReferenceId, decl))
-> (decl -> Decl Symbol Ann) -> [(Hash, [Decl Symbol Ann])]
decls TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right [(Hash, [Decl Symbol Ann])]
-> [(Hash, [Decl Symbol Ann])] -> [(Hash, [Decl Symbol Ann])]
forall a. [a] -> [a] -> [a]
++ (TypecheckedUnisonFile Symbol Ann
 -> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann))
-> (EffectDeclaration Symbol Ann -> Decl Symbol Ann)
-> [(Hash, [Decl Symbol Ann])]
forall decl.
(TypecheckedUnisonFile Symbol Ann
 -> Map Symbol (TermReferenceId, decl))
-> (decl -> Decl Symbol Ann) -> [(Hash, [Decl Symbol Ann])]
decls TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left
                        where
                          decls ::
                            (TypecheckedUnisonFile Symbol Ann -> Map Symbol (TypeReferenceId, decl)) ->
                            (decl -> Decl Symbol Ann) ->
                            [(Hash, [Decl Symbol Ann])]
                          decls :: forall decl.
(TypecheckedUnisonFile Symbol Ann
 -> Map Symbol (TermReferenceId, decl))
-> (decl -> Decl Symbol Ann) -> [(Hash, [Decl Symbol Ann])]
decls TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, decl)
project decl -> Decl Symbol Ann
inject =
                            SlurpResult
slurp0
                              SlurpResult
-> (SlurpResult -> TypecheckedUnisonFile Symbol Ann)
-> TypecheckedUnisonFile Symbol Ann
forall a b. a -> (a -> b) -> b
& SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile
                              TypecheckedUnisonFile Symbol Ann
-> (TypecheckedUnisonFile Symbol Ann
    -> Map Symbol (TermReferenceId, decl))
-> Map Symbol (TermReferenceId, decl)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, decl)
project
                              Map Symbol (TermReferenceId, decl)
-> (Map Symbol (TermReferenceId, decl)
    -> [(TermReferenceId, decl)])
-> [(TermReferenceId, decl)]
forall a b. a -> (a -> b) -> b
& Map Symbol (TermReferenceId, decl) -> [(TermReferenceId, decl)]
forall k a. Map k a -> [a]
Map.elems
                              [(TermReferenceId, decl)]
-> ([(TermReferenceId, decl)] -> [(Hash, [decl])])
-> [(Hash, [decl])]
forall a b. a -> (a -> b) -> b
& [(TermReferenceId, decl)] -> [(Hash, [decl])]
forall a. [(TermReferenceId, a)] -> [(Hash, [a])]
recomponentize
                              [(Hash, [decl])]
-> ([(Hash, [decl])] -> [(Hash, [Decl Symbol Ann])])
-> [(Hash, [Decl Symbol Ann])]
forall a b. a -> (a -> b) -> b
& ASetter
  [(Hash, [decl])] [(Hash, [Decl Symbol Ann])] decl (Decl Symbol Ann)
-> (decl -> Decl Symbol Ann)
-> [(Hash, [decl])]
-> [(Hash, [Decl Symbol Ann])]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Hash, [decl]) -> Identity (Hash, [Decl Symbol Ann]))
-> [(Hash, [decl])] -> Identity [(Hash, [Decl Symbol Ann])]
Setter
  [(Hash, [decl])]
  [(Hash, [Decl Symbol Ann])]
  (Hash, [decl])
  (Hash, [Decl Symbol Ann])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((Hash, [decl]) -> Identity (Hash, [Decl Symbol Ann]))
 -> [(Hash, [decl])] -> Identity [(Hash, [Decl Symbol Ann])])
-> ((decl -> Identity (Decl Symbol Ann))
    -> (Hash, [decl]) -> Identity (Hash, [Decl Symbol Ann]))
-> ASetter
     [(Hash, [decl])] [(Hash, [Decl Symbol Ann])] decl (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([decl] -> Identity [Decl Symbol Ann])
-> (Hash, [decl]) -> Identity (Hash, [Decl Symbol Ann])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Hash, [decl]) (Hash, [Decl Symbol Ann]) [decl] [Decl Symbol Ann]
_2 (([decl] -> Identity [Decl Symbol Ann])
 -> (Hash, [decl]) -> Identity (Hash, [Decl Symbol Ann]))
-> ((decl -> Identity (Decl Symbol Ann))
    -> [decl] -> Identity [Decl Symbol Ann])
-> (decl -> Identity (Decl Symbol Ann))
-> (Hash, [decl])
-> Identity (Hash, [Decl Symbol Ann])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (decl -> Identity (Decl Symbol Ann))
-> [decl] -> Identity [Decl Symbol Ann]
Setter [decl] [Decl Symbol Ann] decl (Decl Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) decl -> Decl Symbol Ann
inject
                      interimTermComponents :: [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
                      interimTermComponents :: [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
interimTermComponents =
                        Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
nameToInterimInfo
                          Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
-> (Map
      Symbol
      (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
       Type Symbol Ann)
    -> [(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
         Type Symbol Ann)])
-> [(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
     Type Symbol Ann)]
forall a b. a -> (a -> b) -> b
& Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
-> [(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
     Type Symbol Ann)]
forall k a. Map k a -> [a]
Map.elems
                          [(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
  Type Symbol Ann)]
-> ([(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)]
    -> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))])
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
  Type Symbol Ann)
 -> (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)))
-> [(Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
     Type Symbol Ann)]
-> [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ann
_ann, TermReferenceId
ref, Maybe WatchKind
_wk, Term Symbol Ann
term, Type Symbol Ann
typ) -> (TermReferenceId
ref, (Term Symbol Ann
term, Type Symbol Ann
typ)))
                          [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> ([(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
    -> Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann)))
-> Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann))
forall a b. a -> (a -> b) -> b
& [(TermReferenceId, (Term Symbol Ann, Type Symbol Ann))]
-> Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann))
forall a. [(TermReferenceId, a)] -> Map Hash (Map Pos a)
componentize
                          Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann))
-> (Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann))
    -> [(Hash, [(Term Symbol Ann, Type Symbol Ann)])])
-> [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
forall a b. a -> (a -> b) -> b
& Map Hash (Map Pos (Term Symbol Ann, Type Symbol Ann))
-> [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
forall a. Map Hash (Map Pos a) -> [(Hash, [a])]
uncomponentize

                  -- Insert each interim component into the codebase proper. Note: this relies on the codebase interface
                  -- being smart enough to handle out-of-order components (i.e. inserting a dependent before a
                  -- dependency). That's currently how the codebase interface works, but maybe in the future it'll grow
                  -- a precondition that components can only be inserted after their dependencies.
                  [(Hash, [Decl Symbol Ann])]
-> ((Hash, [Decl Symbol Ann]) -> Transaction ()) -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Hash, [Decl Symbol Ann])]
interimDeclComponents \(Hash
hash, [Decl Symbol Ann]
decls) -> Codebase IO Symbol Ann
-> Hash -> [Decl Symbol Ann] -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Hash -> [Decl v a] -> Transaction ()
Codebase.putTypeDeclarationComponent Codebase IO Symbol Ann
codebase Hash
hash [Decl Symbol Ann]
decls
                  [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
-> ((Hash, [(Term Symbol Ann, Type Symbol Ann)]) -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
interimTermComponents \(Hash
hash, [(Term Symbol Ann, Type Symbol Ann)]
terms) -> Codebase IO Symbol Ann
-> Hash -> [(Term Symbol Ann, Type Symbol Ann)] -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Hash -> [(Term v a, Type v a)] -> Transaction ()
Codebase.putTermComponent Codebase IO Symbol Ann
codebase Hash
hash [(Term Symbol Ann, Type Symbol Ann)]
terms

                  Map TermReferenceId (Term Symbol Ann, Symbol)
terms <-
                    let interimHashes :: Set Hash
                        interimHashes :: Set Hash
interimHashes = [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList (((Hash, [(Term Symbol Ann, Type Symbol Ann)]) -> Hash)
-> [(Hash, [(Term Symbol Ann, Type Symbol Ann)])] -> [Hash]
forall a b. (a -> b) -> [a] -> [b]
map (Hash, [(Term Symbol Ann, Type Symbol Ann)]) -> Hash
forall a b. (a, b) -> a
fst [(Hash, [(Term Symbol Ann, Type Symbol Ann)])]
interimTermComponents)
                     in Map Hash Hash -> [(Hash, Hash)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Hash Hash
oldHashToInterimHash [(Hash, Hash)]
-> ([(Hash, Hash)]
    -> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol)))
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
forall a b. a -> (a -> b) -> b
& ((Hash, Hash)
 -> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol)))
-> [(Hash, Hash)]
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \(Hash
oldHash, Hash
interimHash) -> do
                          Set Hash
hashes <-
                            Hash -> Transaction (Maybe ObjectId)
Queries.loadObjectIdForAnyHash Hash
oldHash Transaction (Maybe ObjectId)
-> (Maybe ObjectId -> Transaction (Set Hash))
-> Transaction (Set Hash)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                              -- better would be to short-circuit all the way to the user and say, actually we can't
                              -- perform this update at all, due to some intervening delete (e.g. some sort of
                              -- hard-reset or garbage collection on the codebase)
                              Maybe ObjectId
Nothing -> Set Hash -> Transaction (Set Hash)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Hash
forall a. Set a
Set.empty
                              Just ObjectId
oldOid -> do
                                ObjectId
interimOid <- Hash -> Transaction ObjectId
Queries.expectObjectIdForPrimaryHash Hash
interimHash
                                Set ObjectId
betweenOids <- ObjectId -> ObjectId -> Transaction (Set ObjectId)
Queries.getDependenciesBetweenTerms ObjectId
interimOid ObjectId
oldOid
                                (Set Hash -> Set Hash -> Set Hash
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set Hash
interimHashes) (Set Hash -> Set Hash)
-> Transaction (Set Hash) -> Transaction (Set Hash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectId -> Transaction Hash)
-> Set ObjectId -> Transaction (Set Hash)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ObjectId -> Transaction Hash
Queries.expectPrimaryHashByObjectId Set ObjectId
betweenOids
                          (Hash
 -> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol)))
-> [Hash]
-> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM Hash -> Transaction (Map TermReferenceId (Term Symbol Ann, Symbol))
hashToImplicitTerms (Hash
oldHash Hash -> [Hash] -> [Hash]
forall a. a -> [a] -> [a]
: Set Hash -> [Hash]
forall a. Set a -> [a]
Set.toList Set Hash
hashes)
                  pure (Map TermReferenceId (Term Symbol Ann, Symbol)
-> Either
     (Map TermReferenceId (Term Symbol Ann, Symbol))
     (Map TermReferenceId (Term Symbol Ann, Symbol))
forall a b. a -> Either a b
Left Map TermReferenceId (Term Symbol Ann, Symbol)
terms) -- left = rollback to savepoint
    if Map TermReferenceId (Term Symbol Ann, Symbol) -> Bool
forall k a. Map k a -> Bool
Map.null Map TermReferenceId (Term Symbol Ann, Symbol)
implicitTerms
      then SlurpResult -> Cli SlurpResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlurpResult
slurp0
      else do
        -- We found some implicit terms, so it's time to:
        --
        --   1. Reconstruct a new unison file out of the latest typechecked unison file, plus all of the implicit terms,
        --      taking care to adjust their references to each other, so that the proper components are discovered.
        --
        --   2. Re-typecheck, and if it that succeeds, use the resulting typechecked unison file and slurp.

        -- Remap the references contained in each implicit term, then add back in the slurped interim terms and unhash
        -- the collection. The unhashing process will invent a fresh variable name for each term.
        --
        -- Running example:
        --
        --   #newping       => ("fresh1", <"fresh3" + 4>)
        --   #pingpong.pong => ("fresh2", <"fresh1" + 2>)
        --   #wham          => ("fresh3", <"fresh2" + 3>)
        let refToGeneratedNameAndTerm :: Map TermReferenceId (Symbol, Term Symbol Ann)
            refToGeneratedNameAndTerm :: Map TermReferenceId (Symbol, Term Symbol Ann)
refToGeneratedNameAndTerm =
              -- Running example:
              --
              --   #pingpong.pong => (<#pingpong.ping + 2>, { "pong" })
              --   #wham          => (<#pingpong.pong + 3>, { "wham" })
              Map TermReferenceId (Term Symbol Ann, Symbol)
implicitTerms
                -- Running example:
                --
                --   #pingpong.pong => <#newping + 2>
                --   #wham          => <#pingpong.pong + 3>
                Map TermReferenceId (Term Symbol Ann, Symbol)
-> (Map TermReferenceId (Term Symbol Ann, Symbol)
    -> Map TermReferenceId (Term Symbol Ann))
-> Map TermReferenceId (Term Symbol Ann)
forall a b. a -> (a -> b) -> b
& ((Term Symbol Ann, Symbol) -> Term Symbol Ann)
-> Map TermReferenceId (Term Symbol Ann, Symbol)
-> Map TermReferenceId (Term Symbol Ann)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Term Symbol Ann
term, Symbol
_names) -> Term Symbol Ann -> Term Symbol Ann
rewrite Term Symbol Ann
term)
                -- Running example:
                --
                --   #newping       => <#wham + 4>
                --   #pingpong.pong => <#newping + 2>
                --   #wham          => <#pingpong.pong + 3>
                Map TermReferenceId (Term Symbol Ann)
-> (Map TermReferenceId (Term Symbol Ann)
    -> Map TermReferenceId (Term Symbol Ann))
-> Map TermReferenceId (Term Symbol Ann)
forall a b. a -> (a -> b) -> b
& Map TermReferenceId (Term Symbol Ann)
-> Map TermReferenceId (Term Symbol Ann)
-> Map TermReferenceId (Term Symbol Ann)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map TermReferenceId (Term Symbol Ann)
interimRefToTerm
                Map TermReferenceId (Term Symbol Ann)
-> (Map TermReferenceId (Term Symbol Ann)
    -> Map TermReferenceId (Symbol, Term Symbol Ann))
-> Map TermReferenceId (Symbol, Term Symbol Ann)
forall a b. a -> (a -> b) -> b
& Map TermReferenceId (Term Symbol Ann)
-> Map TermReferenceId (Symbol, Term Symbol Ann)
forall v a.
Var v =>
Map TermReferenceId (Term v a) -> Map TermReferenceId (v, Term v a)
Term.unhashComponent
              where
                -- Running example:
                --
                --   #newping => <#wham + 4>
                interimRefToTerm :: Map TermReferenceId (Term Symbol Ann)
                interimRefToTerm :: Map TermReferenceId (Term Symbol Ann)
interimRefToTerm =
                  ((Symbol,
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann))
 -> (TermReferenceId, Term Symbol Ann))
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
-> Map TermReferenceId (Term Symbol Ann)
forall k1 k0 v0 v1.
Ord k1 =>
((k0, v0) -> (k1, v1)) -> Map k0 v0 -> Map k1 v1
Map.remap (\(Symbol
_var, (Ann
_ann, TermReferenceId
ref, Maybe WatchKind
_wk, Term Symbol Ann
term, Type Symbol Ann
_typ)) -> (TermReferenceId
ref, Term Symbol Ann
term)) Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
nameToInterimInfo
                -- Running example: apply the following reference mapping everwhere in a term:
                --
                --   #pingpong.ping -> #newping
                --   ref            -> ref
                rewrite :: Term Symbol Ann -> Term Symbol Ann
                rewrite :: Term Symbol Ann -> Term Symbol Ann
rewrite =
                  Map TermReference TermReferenceId
-> Term Symbol Ann -> Term Symbol Ann
forall v a.
Ord v =>
Map TermReference TermReferenceId -> Term v a -> Term v a
rewriteTermReferences (((Set TermReference, TermReferenceId)
 -> Map TermReference TermReferenceId)
-> Map Symbol (Set TermReference, TermReferenceId)
-> Map TermReference TermReferenceId
forall m a. Monoid m => (a -> m) -> Map Symbol a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set TermReference, TermReferenceId)
-> Map TermReference TermReferenceId
toMapping Map Symbol (Set TermReference, TermReferenceId)
updatedNameToRefs)
                  where
                    toMapping ::
                      (Set TermReference, TermReferenceId) ->
                      Map TermReference TermReferenceId
                    toMapping :: (Set TermReference, TermReferenceId)
-> Map TermReference TermReferenceId
toMapping (Set TermReference
oldRefs, TermReferenceId
interimRef) =
                      (TermReference -> Map TermReference TermReferenceId)
-> Set TermReference -> Map TermReference TermReferenceId
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\TermReference
oldRef -> TermReference
-> TermReferenceId -> Map TermReference TermReferenceId
forall k a. k -> a -> Map k a
Map.singleton TermReference
oldRef TermReferenceId
interimRef) Set TermReference
oldRefs

        let unisonFile :: UnisonFile Symbol Ann
            unisonFile :: UnisonFile Symbol Ann
unisonFile =
              UF.UnisonFileId
                { $sel:dataDeclarationsId:UnisonFileId :: Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
dataDeclarationsId = TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
slurp0),
                  $sel:effectDeclarationsId:UnisonFileId :: Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
effectDeclarationsId = TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' (SlurpResult -> TypecheckedUnisonFile Symbol Ann
Slurp.originalFile SlurpResult
slurp0),
                  -- Running example:
                  --
                  --   fresh1 = fresh3 + 4
                  --   fresh2 = fresh1 + 2
                  --   fresh3 = fresh2 + 3
                  $sel:terms:UnisonFileId :: Map Symbol (Ann, Term Symbol Ann)
terms =
                    [(Symbol, (Ann, Term Symbol Ann))]
-> Map Symbol (Ann, Term Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Symbol, (Ann, Term Symbol Ann))]
 -> Map Symbol (Ann, Term Symbol Ann))
-> [(Symbol, (Ann, Term Symbol Ann))]
-> Map Symbol (Ann, Term Symbol Ann)
forall a b. (a -> b) -> a -> b
$ Map TermReferenceId (Symbol, Term Symbol Ann)
-> [(Symbol, Term Symbol Ann)]
forall k a. Map k a -> [a]
Map.elems Map TermReferenceId (Symbol, Term Symbol Ann)
refToGeneratedNameAndTerm [(Symbol, Term Symbol Ann)]
-> ((Symbol, Term Symbol Ann) -> (Symbol, (Ann, Term Symbol Ann)))
-> [(Symbol, (Ann, Term Symbol Ann))]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Symbol
v, Term Symbol Ann
term) -> (Symbol
v, (Ann
External, Term Symbol Ann
term)),
                  -- In the context of this update, whatever watches were in the latest typechecked Unison file are
                  -- irrelevant, so we don't need to copy them over.
                  $sel:watches:UnisonFileId :: Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
watches = Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
forall k a. Map k a
Map.empty
                }
        Env Symbol Ann
typecheckingEnv <-
          IO (Env Symbol Ann) -> Cli (Env Symbol Ann)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
            Codebase IO Symbol Ann
-> Transaction (Env Symbol Ann) -> IO (Env Symbol Ann)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
              ShouldUseTndr Transaction
-> Codebase IO Symbol Ann
-> [Type Symbol Ann]
-> UnisonFile Symbol Ann
-> Transaction (Env Symbol Ann)
computeTypecheckingEnvironment ShouldUseTndr Transaction
forall (m :: * -> *). ShouldUseTndr m
FileParsers.ShouldUseTndr'No Codebase IO Symbol Ann
codebase [] UnisonFile Symbol Ann
unisonFile
        case Result (Seq (Note Symbol Ann)) (TypecheckedUnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall notes a. Result notes a -> Maybe a
Result.result (Env Symbol Ann
-> UnisonFile Symbol Ann
-> Result
     (Seq (Note Symbol Ann)) (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
FileParsers.synthesizeFile Env Symbol Ann
typecheckingEnv UnisonFile Symbol Ann
unisonFile) of
          Just TypecheckedUnisonFile Symbol Ann
file0 -> do
            -- Map each name generated by unhashing back to the name it should have in the Unison file we're going to
            -- typecheck.
            --
            -- Running example:
            --
            --   "fresh1" -> "ping"
            --   "fresh2" -> "pong"
            --   "fresh3" -> "wham"
            let generatedNameToName :: Map Symbol Symbol
                generatedNameToName :: Map Symbol Symbol
generatedNameToName =
                  Map TermReferenceId (Symbol, Term Symbol Ann)
refToGeneratedNameAndTerm Map TermReferenceId (Symbol, Term Symbol Ann)
-> (Map TermReferenceId (Symbol, Term Symbol Ann)
    -> Map Symbol Symbol)
-> Map Symbol Symbol
forall a b. a -> (a -> b) -> b
& ((TermReferenceId, (Symbol, Term Symbol Ann)) -> (Symbol, Symbol))
-> Map TermReferenceId (Symbol, Term Symbol Ann)
-> Map Symbol Symbol
forall k1 k0 v0 v1.
Ord k1 =>
((k0, v0) -> (k1, v1)) -> Map k0 v0 -> Map k1 v1
Map.remap \(TermReferenceId
ref, (Symbol
generatedName, Term Symbol Ann
_term)) ->
                    ( Symbol
generatedName,
                      case TermReferenceId -> Map TermReferenceId Symbol -> Maybe Symbol
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId Symbol
interimRefToName of
                        Just Symbol
name -> Symbol
name
                        Maybe Symbol
Nothing ->
                          case TermReferenceId
-> Map TermReferenceId (Term Symbol Ann, Symbol)
-> Maybe (Term Symbol Ann, Symbol)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId (Term Symbol Ann, Symbol)
implicitTerms of
                            Just (Term Symbol Ann
_term, Symbol
name) -> Symbol
name
                            Maybe (Term Symbol Ann, Symbol)
Nothing -> WatchKind -> Symbol
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> WatchKind -> WatchKind
reportBug WatchKind
"E836680" WatchKind
"ref not interim nor implicit")
                    )
                  where
                    -- Associate each term name being updated with its interim reference.
                    --
                    -- Running example:
                    --
                    --   #newping => "ping"
                    interimRefToName :: Map TermReferenceId Symbol
                    interimRefToName :: Map TermReferenceId Symbol
interimRefToName =
                      ((Symbol,
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann))
 -> (TermReferenceId, Symbol))
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
      Type Symbol Ann)
-> Map TermReferenceId Symbol
forall k1 k0 v0 v1.
Ord k1 =>
((k0, v0) -> (k1, v1)) -> Map k0 v0 -> Map k1 v1
Map.remap (\(Symbol
name, (Ann
_ann, TermReferenceId
ref, Maybe WatchKind
_wk, Term Symbol Ann
_term, Type Symbol Ann
_typ)) -> (TermReferenceId
ref, Symbol
name)) Map
  Symbol
  (Ann, TermReferenceId, Maybe WatchKind, Term Symbol Ann,
   Type Symbol Ann)
nameToInterimInfo

            let renameTerm ::
                  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) ->
                  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
                renameTerm :: (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
renameTerm (Symbol
generatedName, Ann
ann, Term Symbol Ann
term, Type Symbol Ann
typ) =
                  ( case Symbol -> Map Symbol Symbol -> Maybe Symbol
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
generatedName Map Symbol Symbol
generatedNameToName of
                      Just Symbol
name -> Symbol
name
                      Maybe Symbol
Nothing -> WatchKind -> Symbol
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> WatchKind -> WatchKind
reportBug WatchKind
"E440546" WatchKind
"no name for generated name"),
                    Ann
ann,
                    Map Symbol Symbol -> Term Symbol Ann -> Term Symbol Ann
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames Map Symbol Symbol
generatedNameToName Term Symbol Ann
term,
                    Type Symbol Ann
typ
                  )

            let file1 :: TypecheckedUnisonFile Symbol Ann
                file1 :: TypecheckedUnisonFile Symbol Ann
file1 =
                  Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (TermReferenceId, DataDeclaration v a)
-> Map v (TermReferenceId, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(WatchKind, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
                    (TypecheckedUnisonFile Symbol Ann
file0 TypecheckedUnisonFile Symbol Ann
-> Getting
     (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann))
     (TypecheckedUnisonFile Symbol Ann)
     (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann))
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann))
  (TypecheckedUnisonFile Symbol Ann)
  (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann))
#dataDeclarationsId')
                    (TypecheckedUnisonFile Symbol Ann
file0 TypecheckedUnisonFile Symbol Ann
-> Getting
     (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann))
     (TypecheckedUnisonFile Symbol Ann)
     (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann))
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann))
  (TypecheckedUnisonFile Symbol Ann)
  (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann))
#effectDeclarationsId')
                    ((TypecheckedUnisonFile Symbol Ann
file0 TypecheckedUnisonFile Symbol Ann
-> Getting
     [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
     (TypecheckedUnisonFile Symbol Ann)
     [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall s a. s -> Getting a s a -> a
^. Getting
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
  (TypecheckedUnisonFile Symbol Ann)
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
#topLevelComponents') [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> ([[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
    -> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]])
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a b. a -> (a -> b) -> b
& ASetter
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
    -> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
 -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> Identity [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
Setter
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
  [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
 -> Identity [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]])
-> (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
     -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
    -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
    -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> ASetter
     [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
     [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
     (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
     (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
 -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
Setter
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
renameTerm)
                    ((TypecheckedUnisonFile Symbol Ann
file0 TypecheckedUnisonFile Symbol Ann
-> Getting
     [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
     (TypecheckedUnisonFile Symbol Ann)
     [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
  (TypecheckedUnisonFile Symbol Ann)
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
#watchComponents) [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> ([(WatchKind,
      [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
    -> [(WatchKind,
         [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])])
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a b. a -> (a -> b) -> b
& ASetter
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
    -> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> Identity
      (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]))
-> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Identity
     [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
Setter
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
  [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
  (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
  (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
  -> Identity
       (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]))
 -> [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
 -> Identity
      [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])])
-> (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
     -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
    -> (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
    -> Identity
         (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]))
-> ASetter
     [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
     [(WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
     (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
     (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
 -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Identity
     (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
  (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
_2 (([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> Identity
      (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]))
-> (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
     -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
    -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
    -> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
    -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
-> (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Identity
     (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
 -> Identity (Symbol, Ann, Term Symbol Ann, Type Symbol Ann))
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> Identity [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
Setter
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
  (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
renameTerm)

            SlurpResult -> Cli SlurpResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypecheckedUnisonFile Symbol Ann -> SlurpResult
slurp TypecheckedUnisonFile Symbol Ann
file1)
          Maybe (TypecheckedUnisonFile Symbol Ann)
_ -> SlurpResult -> Cli SlurpResult
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlurpResult
slurp0

  pure SlurpResult
slurp1

rewriteTermReferences :: (Ord v) => Map TermReference TermReferenceId -> Term v a -> Term v a
rewriteTermReferences :: forall v a.
Ord v =>
Map TermReference TermReferenceId -> Term v a -> Term v a
rewriteTermReferences Map TermReference TermReferenceId
mapping =
  (F v a a (Term (F v a a) v a) -> F v a a (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(f (Term f v a) -> f (Term f v a)) -> Term f v a -> Term f v a
ABT.rebuildUp \F v a a (Term (F v a a) v a)
term ->
    case F v a a (Term (F v a a) v a)
term of
      Term.Ref TermReference
ref0 ->
        case TermReference
-> Map TermReference TermReferenceId -> Maybe TermReferenceId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReference
ref0 Map TermReference TermReferenceId
mapping of
          Maybe TermReferenceId
Nothing -> F v a a (Term (F v a a) v a)
term
          Just TermReferenceId
ref1 -> TermReference -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
TermReference -> F typeVar typeAnn patternAnn a
Term.Ref (TermReferenceId -> TermReference
Reference.fromId TermReferenceId
ref1)
      F v a a (Term (F v a a) v a)
_ -> F v a a (Term (F v a a) v a)
term

-- updates the namespace for adding `slurp`
doSlurpAdds ::
  forall m.
  (Monad m) =>
  SlurpComponent ->
  TypecheckedUnisonFile Symbol Ann ->
  (Branch0 m -> Branch0 m)
doSlurpAdds :: forall (m :: * -> *).
Monad m =>
SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 m -> Branch0 m
doSlurpAdds SlurpComponent
slurp TypecheckedUnisonFile Symbol Ann
uf = [(Path, Branch0 m -> Branch0 m)] -> Branch0 m -> Branch0 m
forall (f :: * -> *) (m :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
Branch.batchUpdates ([(Path, Branch0 m -> Branch0 m)]
typeActions [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Branch0 m -> Branch0 m)]
termActions)
  where
    typeActions :: [(Path, Branch0 m -> Branch0 m)]
typeActions = (Symbol -> (Path, Branch0 m -> Branch0 m))
-> [Symbol] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> (Path, Branch0 m -> Branch0 m)
doType ([Symbol] -> [(Path, Branch0 m -> Branch0 m)])
-> (Set Symbol -> [Symbol])
-> Set Symbol
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Symbol -> [(Path, Branch0 m -> Branch0 m)])
-> Set Symbol -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ SlurpComponent -> Set Symbol
SC.types SlurpComponent
slurp
    termActions :: [(Path, Branch0 m -> Branch0 m)]
termActions =
      (Symbol -> (Path, Branch0 m -> Branch0 m))
-> [Symbol] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> (Path, Branch0 m -> Branch0 m)
doTerm ([Symbol] -> [(Path, Branch0 m -> Branch0 m)])
-> (Set Symbol -> [Symbol])
-> Set Symbol
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Symbol -> [(Path, Branch0 m -> Branch0 m)])
-> Set Symbol -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$
        SlurpComponent -> Set Symbol
SC.terms SlurpComponent
slurp Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol -> TypecheckedUnisonFile Symbol Ann -> Set Symbol
forall v a. Ord v => Set v -> TypecheckedUnisonFile v a -> Set v
UF.constructorsForDecls (SlurpComponent -> Set Symbol
SC.types SlurpComponent
slurp) TypecheckedUnisonFile Symbol Ann
uf
    names :: Names
names = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
uf
    doTerm :: Symbol -> (Path, Branch0 m -> Branch0 m)
    doTerm :: Symbol -> (Path, Branch0 m -> Branch0 m)
doTerm Symbol
v = case Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Name -> Set Referent
Names.termsNamed Names
names (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)) of
      [] -> Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v
      [Referent
r] ->
        let split :: Split
split = Name -> Split
Path.splitFromName (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
         in Split -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split
split Referent
r
      [Referent]
wha ->
        WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> (Path, Branch0 m -> Branch0 m))
-> WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$
          WatchKind
"Unison bug, typechecked file w/ multiple terms named "
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> Symbol -> WatchKind
forall v. Var v => v -> WatchKind
Var.nameStr Symbol
v
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> WatchKind
": "
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> [Referent] -> WatchKind
forall a. Show a => a -> WatchKind
show [Referent]
wha
    doType :: Symbol -> (Path, Branch0 m -> Branch0 m)
    doType :: Symbol -> (Path, Branch0 m -> Branch0 m)
doType Symbol
v = case Set TermReference -> [TermReference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Name -> Set TermReference
Names.typesNamed Names
names (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)) of
      [] -> Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v
      [TermReference
r] ->
        let split :: Split
split = Name -> Split
Path.splitFromName (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
         in Split -> TermReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TermReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split
split TermReference
r
      [TermReference]
wha ->
        WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> (Path, Branch0 m -> Branch0 m))
-> WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$
          WatchKind
"Unison bug, typechecked file w/ multiple types named "
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> Symbol -> WatchKind
forall v. Var v => v -> WatchKind
Var.nameStr Symbol
v
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> WatchKind
": "
            WatchKind -> WatchKind -> WatchKind
forall a. Semigroup a => a -> a -> a
<> [TermReference] -> WatchKind
forall a. Show a => a -> WatchKind
show [TermReference]
wha
    errorMissingVar :: Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v = WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> (Path, Branch0 m -> Branch0 m))
-> WatchKind -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$ WatchKind
"expected to find " WatchKind -> WatchKind -> WatchKind
forall a. [a] -> [a] -> [a]
++ Symbol -> WatchKind
forall a. Show a => a -> WatchKind
show Symbol
v WatchKind -> WatchKind -> WatchKind
forall a. [a] -> [a] -> [a]
++ WatchKind
" in " WatchKind -> WatchKind -> WatchKind
forall a. [a] -> [a] -> [a]
++ TypecheckedUnisonFile Symbol Ann -> WatchKind
forall a. Show a => a -> WatchKind
show TypecheckedUnisonFile Symbol Ann
uf

doSlurpUpdates ::
  (Monad m) =>
  [(Name, TypeReference, TypeReference)] ->
  [(Name, TermReference, TermReference)] ->
  [(Name, Referent)] ->
  (Branch0 m -> Branch0 m)
doSlurpUpdates :: forall (m :: * -> *).
Monad m =>
[(Name, TermReference, TermReference)]
-> [(Name, TermReference, TermReference)]
-> [(Name, Referent)]
-> Branch0 m
-> Branch0 m
doSlurpUpdates [(Name, TermReference, TermReference)]
typeEdits [(Name, TermReference, TermReference)]
termEdits [(Name, Referent)]
deprecated Branch0 m
b0 =
  [(Path, Branch0 m -> Branch0 m)] -> Branch0 m -> Branch0 m
forall (f :: * -> *) (m :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
Branch.batchUpdates ([(Path, Branch0 m -> Branch0 m)]
typeActions [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Branch0 m -> Branch0 m)]
termActions [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Branch0 m -> Branch0 m)]
deprecateActions) Branch0 m
b0
  where
    typeActions :: [(Path, Branch0 m -> Branch0 m)]
typeActions = [[(Path, Branch0 m -> Branch0 m)]]
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Path, Branch0 m -> Branch0 m)]]
 -> [(Path, Branch0 m -> Branch0 m)])
-> ([(Name, TermReference, TermReference)]
    -> [[(Path, Branch0 m -> Branch0 m)]])
-> [(Name, TermReference, TermReference)]
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, TermReference, TermReference)
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, TermReference, TermReference)]
-> [[(Path, Branch0 m -> Branch0 m)]]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
(Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
doType ([(Name, TermReference, TermReference)]
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, TermReference, TermReference)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ [(Name, TermReference, TermReference)]
typeEdits
    termActions :: [(Path, Branch0 m -> Branch0 m)]
termActions = [[(Path, Branch0 m -> Branch0 m)]]
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Path, Branch0 m -> Branch0 m)]]
 -> [(Path, Branch0 m -> Branch0 m)])
-> ([(Name, TermReference, TermReference)]
    -> [[(Path, Branch0 m -> Branch0 m)]])
-> [(Name, TermReference, TermReference)]
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, TermReference, TermReference)
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, TermReference, TermReference)]
-> [[(Path, Branch0 m -> Branch0 m)]]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
(Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
doTerm ([(Name, TermReference, TermReference)]
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, TermReference, TermReference)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ [(Name, TermReference, TermReference)]
termEdits
    deprecateActions :: [(Path, Branch0 m -> Branch0 m)]
deprecateActions = [[(Path, Branch0 m -> Branch0 m)]]
-> [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Path, Branch0 m -> Branch0 m)]]
 -> [(Path, Branch0 m -> Branch0 m)])
-> ([(Name, Referent)] -> [[(Path, Branch0 m -> Branch0 m)]])
-> [(Name, Referent)]
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Referent) -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, Referent)] -> [[(Path, Branch0 m -> Branch0 m)]]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Referent) -> [(Path, Branch0 m -> Branch0 m)]
forall {m :: * -> *}.
(Name, Referent) -> [(Path, Branch0 m -> Branch0 m)]
doDeprecate ([(Name, Referent)] -> [(Path, Branch0 m -> Branch0 m)])
-> [(Name, Referent)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ [(Name, Referent)]
deprecated
      where
        doDeprecate :: (Name, Referent) -> [(Path, Branch0 m -> Branch0 m)]
doDeprecate (Name
n, Referent
r) = [Split -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTermName (Name -> Split
Path.splitFromName Name
n) Referent
r]

    doType :: (Name, TypeReference, TypeReference) -> [(Path, Branch0 m -> Branch0 m)]
    doType :: forall (m :: * -> *).
(Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
doType (Name
n, TermReference
old, TermReference
new) =
      let split :: Split
split = Name -> Split
Path.splitFromName Name
n
       in [ Split -> TermReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TermReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTypeName Split
split TermReference
old,
            Split -> TermReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TermReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split
split TermReference
new
          ]
    doTerm :: (Name, TermReference, TermReference) -> [(Path, Branch0 m -> Branch0 m)]
    doTerm :: forall (m :: * -> *).
(Name, TermReference, TermReference)
-> [(Path, Branch0 m -> Branch0 m)]
doTerm (Name
n, TermReference
old, TermReference
new) =
      [ Split -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTermName Split
split (TermReference -> Referent
Referent.Ref TermReference
old),
        Split -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split
split (TermReference -> Referent
Referent.Ref TermReference
new)
      ]
      where
        split :: Split
split = Name -> Split
Path.splitFromName Name
n

-- Returns True if the operation changed the namespace, False otherwise.
propagatePatch :: Patch -> Path.Path -> Branch.Branch IO -> Cli (Branch.Branch IO)
propagatePatch :: Patch -> Path -> Branch IO -> Cli (Branch IO)
propagatePatch Patch
patch Path
scopePath Branch IO
b = do
  WatchKind -> Cli (Branch IO) -> Cli (Branch IO)
forall a. WatchKind -> Cli a -> Cli a
Cli.time WatchKind
"propagatePatchNoSync" do
    let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Branch0 IO -> Names
forall a b. (a -> b) -> a -> b
$ Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
b
    [(Path, Branch0 IO -> Cli (Branch0 IO))]
-> Branch IO -> Cli (Branch IO)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
Branch.stepManyAtM [(Path
scopePath, Names -> Patch -> Branch0 IO -> Cli (Branch0 IO)
Propagate.propagateAndApply Names
names Patch
patch)] Branch IO
b

recomponentize :: [(Reference.Id, a)] -> [(Hash, [a])]
recomponentize :: forall a. [(TermReferenceId, a)] -> [(Hash, [a])]
recomponentize =
  Map Hash (Map Pos a) -> [(Hash, [a])]
forall a. Map Hash (Map Pos a) -> [(Hash, [a])]
uncomponentize (Map Hash (Map Pos a) -> [(Hash, [a])])
-> ([(TermReferenceId, a)] -> Map Hash (Map Pos a))
-> [(TermReferenceId, a)]
-> [(Hash, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TermReferenceId, a)] -> Map Hash (Map Pos a)
forall a. [(TermReferenceId, a)] -> Map Hash (Map Pos a)
componentize

-- Misc. helper: convert a component in listy-form to mappy-form.
componentize :: [(Reference.Id, a)] -> Map Hash (Map Reference.Pos a)
componentize :: forall a. [(TermReferenceId, a)] -> Map Hash (Map Pos a)
componentize =
  (Map Hash (Map Pos a)
 -> (TermReferenceId, a) -> Map Hash (Map Pos a))
-> Map Hash (Map Pos a)
-> [(TermReferenceId, a)]
-> Map Hash (Map Pos a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Hash (Map Pos a)
-> (TermReferenceId, a) -> Map Hash (Map Pos a)
forall a.
Map Hash (Map Pos a)
-> (TermReferenceId, a) -> Map Hash (Map Pos a)
step Map Hash (Map Pos a)
forall k a. Map k a
Map.empty
  where
    step :: Map Hash (Map Reference.Pos a) -> (Reference.Id, a) -> Map Hash (Map Reference.Pos a)
    step :: forall a.
Map Hash (Map Pos a)
-> (TermReferenceId, a) -> Map Hash (Map Pos a)
step Map Hash (Map Pos a)
acc (Reference.Id Hash
hash Pos
pos, a
x) =
      (Maybe (Map Pos a) -> Map Pos a)
-> Hash -> Map Hash (Map Pos a) -> Map Hash (Map Pos a)
forall k v. Ord k => (Maybe v -> v) -> k -> Map k v -> Map k v
Map.upsert
        ( \case
            Maybe (Map Pos a)
Nothing -> Pos -> a -> Map Pos a
forall k a. k -> a -> Map k a
Map.singleton Pos
pos a
x
            Just Map Pos a
acc1 -> Pos -> a -> Map Pos a -> Map Pos a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Pos
pos a
x Map Pos a
acc1
        )
        Hash
hash
        Map Hash (Map Pos a)
acc

-- Misc. helper: convert a component in mappy-form to listy-form.
uncomponentize :: Map Hash (Map Reference.Pos a) -> [(Hash, [a])]
uncomponentize :: forall a. Map Hash (Map Pos a) -> [(Hash, [a])]
uncomponentize =
  ASetter [(Hash, Map Pos a)] [(Hash, [a])] (Map Pos a) [a]
-> (Map Pos a -> [a]) -> [(Hash, Map Pos a)] -> [(Hash, [a])]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Hash, Map Pos a) -> Identity (Hash, [a]))
-> [(Hash, Map Pos a)] -> Identity [(Hash, [a])]
Setter
  [(Hash, Map Pos a)] [(Hash, [a])] (Hash, Map Pos a) (Hash, [a])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((Hash, Map Pos a) -> Identity (Hash, [a]))
 -> [(Hash, Map Pos a)] -> Identity [(Hash, [a])])
-> ((Map Pos a -> Identity [a])
    -> (Hash, Map Pos a) -> Identity (Hash, [a]))
-> ASetter [(Hash, Map Pos a)] [(Hash, [a])] (Map Pos a) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Pos a -> Identity [a])
-> (Hash, Map Pos a) -> Identity (Hash, [a])
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Hash, Map Pos a) (Hash, [a]) (Map Pos a) [a]
_2) Map Pos a -> [a]
forall k a. Map k a -> [a]
Map.elems ([(Hash, Map Pos a)] -> [(Hash, [a])])
-> (Map Hash (Map Pos a) -> [(Hash, Map Pos a)])
-> Map Hash (Map Pos a)
-> [(Hash, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Hash (Map Pos a) -> [(Hash, Map Pos a)]
forall k a. Map k a -> [(k, a)]
Map.toList