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

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

import Control.Lens (mapped, (.=))
import Control.Monad.Reader.Class (ask)
import Data.Bifoldable (bifoldMap)
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.Reference (Reference, Reference' (..), TermReferenceId)
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty qualified as Pretty
import Unison.Cli.UpdateUtils (getNamespaceDependentsOf2, hydrateDefns, narrowDefns, parseAndTypecheck)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Output (Output)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.SqliteCodebase.Operations qualified as Operations
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as Decl
import Unison.DeclNameLookup (DeclNameLookup (..))
import Unison.Merge qualified as Merge
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 (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference (fromId)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Sqlite (Transaction)
import Unison.Symbol (Symbol)
import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile)
import Unison.Syntax.Name qualified as Name
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.UnisonFile.Type (TypecheckedUnisonFile)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Nametree (flattenNametrees)
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as Relation
import Unison.Var (Var)
import Unison.WatchKind qualified as WK

handleUpdate2 :: Cli ()
handleUpdate2 :: Cli ()
handleUpdate2 = do
  Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  TypecheckedUnisonFile Symbol Ann
tuf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
  let termAndDeclNames :: DefnsF Set Name Name
termAndDeclNames = TypecheckedUnisonFile Symbol Ann -> DefnsF Set Name Name
forall v a.
Var v =>
TypecheckedUnisonFile v a -> DefnsF Set Name Name
getTermAndDeclNames TypecheckedUnisonFile Symbol Ann
tuf
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  Branch0 IO
currentBranch0 <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  let currentBranch0ExcludingLibdeps :: Branch0 IO
currentBranch0ExcludingLibdeps = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentBranch0
  let namesIncludingLibdeps :: Names
namesIncludingLibdeps = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch0

  -- Assert that the namespace doesn't have any conflicted names
  Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree <-
    DefnsF (Relation Name) Referent TypeReference
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall term typ.
(Ord term, Ord typ) =>
DefnsF (Relation Name) term typ
-> Either
     (Defn (Conflicted Name term) (Conflicted Name typ))
     (Nametree (DefnsF (Map NameSegment) term typ))
narrowDefns (Branch0 IO -> DefnsF (Relation Name) Referent TypeReference
forall (m :: * -> *).
Branch0 m -> DefnsF (Relation Name) Referent TypeReference
Branch.deepDefns Branch0 IO
currentBranch0ExcludingLibdeps)
      Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> (Either
      (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
    -> Cli
         (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Cli (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Cli
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-> Cli (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft (Output
-> Cli (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli
      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Output)
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Cli (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Output
Output.ConflictedDefn Text
"update")

  let defns :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
      defns :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns =
        Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
forall term typ.
(Ord term, Ord typ) =>
Nametree (DefnsF (Map NameSegment) term typ)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
flattenNametrees Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree

  -- Get the number of constructors for every type declaration
  Map (Id' Hash) Int
numConstructors <-
    Transaction (Map (Id' Hash) Int) -> Cli (Map (Id' Hash) Int)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
defns.types
        BiMultimap TypeReference Name
-> (BiMultimap TypeReference Name -> Set TypeReference)
-> Set TypeReference
forall a b. a -> (a -> b) -> b
& BiMultimap TypeReference Name -> Set TypeReference
forall a b. BiMultimap a b -> Set a
BiMultimap.dom
        Set TypeReference
-> (Set TypeReference -> [TypeReference]) -> [TypeReference]
forall a b. a -> (a -> b) -> b
& Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList
        [TypeReference]
-> ([TypeReference] -> Transaction (Map (Id' Hash) Int))
-> Transaction (Map (Id' Hash) Int)
forall a b. a -> (a -> b) -> b
& (Map (Id' Hash) Int
 -> TypeReference -> Transaction (Map (Id' Hash) Int))
-> Map (Id' Hash) Int
-> [TypeReference]
-> Transaction (Map (Id' Hash) Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM
          ( \Map (Id' Hash) Int
acc -> \case
              ReferenceBuiltin Text
_ -> Map (Id' Hash) Int -> Transaction (Map (Id' Hash) Int)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Id' Hash) Int
acc
              ReferenceDerived Id' Hash
ref -> do
                Int
num <- Id' Hash -> Transaction Int
Operations.expectDeclNumConstructors Id' Hash
ref
                Map (Id' Hash) Int -> Transaction (Map (Id' Hash) Int)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Id' Hash) Int -> Transaction (Map (Id' Hash) Int))
-> Map (Id' Hash) Int -> Transaction (Map (Id' Hash) Int)
forall a b. (a -> b) -> a -> b
$! Id' Hash -> Int -> Map (Id' Hash) Int -> Map (Id' Hash) Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id' Hash
ref Int
num Map (Id' Hash) Int
acc
          )
          Map (Id' Hash) Int
forall k a. Map k a
Map.empty

  -- Assert that the namespace doesn't have any incoherent decls
  DeclNameLookup
declNameLookup <-
    HasCallStack =>
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Map (Id' Hash) Int -> Either IncoherentDeclReason DeclNameLookup
Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Map (Id' Hash) Int -> Either IncoherentDeclReason DeclNameLookup
Merge.checkDeclCoherency Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree Map (Id' Hash) Int
numConstructors
      Either IncoherentDeclReason DeclNameLookup
-> (Either IncoherentDeclReason DeclNameLookup
    -> Cli DeclNameLookup)
-> Cli DeclNameLookup
forall a b. a -> (a -> b) -> b
& (IncoherentDeclReason -> Cli DeclNameLookup)
-> Either IncoherentDeclReason DeclNameLookup -> Cli DeclNameLookup
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft (Output -> Cli DeclNameLookup
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli DeclNameLookup)
-> (IncoherentDeclReason -> Output)
-> IncoherentDeclReason
-> Cli DeclNameLookup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IncoherentDeclReason -> Output
Output.IncoherentDeclDuringUpdate)

  Output -> Cli ()
Cli.respond Output
Output.UpdateLookingForDependents

  (DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents, DefnsF
  (Map Name)
  (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
  (Id' Hash, Decl Symbol Ann)
hydratedDependents) <-
    Transaction
  (DefnsF (Map Name) (Id' Hash) (Id' Hash),
   DefnsF
     (Map Name)
     (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
     (Id' Hash, Decl Symbol Ann))
-> Cli
     (DefnsF (Map Name) (Id' Hash) (Id' Hash),
      DefnsF
        (Map Name)
        (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
        (Id' Hash, Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
      -- Get all dependents of things being updated
      DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents0 <-
        Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Set TypeReference
-> Transaction (DefnsF (Map Name) (Id' Hash) (Id' Hash))
getNamespaceDependentsOf2
          (Nametree (DefnsF (Map NameSegment) Referent TypeReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
forall term typ.
(Ord term, Ord typ) =>
Nametree (DefnsF (Map NameSegment) term typ)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
flattenNametrees Nametree (DefnsF (Map NameSegment) Referent TypeReference)
nametree)
          (DefnsF Set Name Name -> Names -> Set TypeReference
getExistingReferencesNamed DefnsF Set Name Name
termAndDeclNames (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch0ExcludingLibdeps))

      -- Throw away the dependents that are shadowed by the file itself
      let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId
          dependents1 :: DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents1 =
            (Map Name (Id' Hash) -> Map Name (Id' Hash))
-> (Map Name (Id' Hash) -> Map Name (Id' Hash))
-> DefnsF (Map Name) (Id' Hash) (Id' Hash)
-> DefnsF (Map Name) (Id' Hash) (Id' Hash)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
              (Map Name (Id' Hash) -> Set Name -> Map Name (Id' Hash)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (TypecheckedUnisonFile Symbol Ann -> Set Symbol
forall v a. Ord v => TypecheckedUnisonFile v a -> Set v
UF.termNamespaceBindings TypecheckedUnisonFile Symbol Ann
tuf)))
              (Map Name (Id' Hash) -> Set Name -> Map Name (Id' Hash)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (TypecheckedUnisonFile Symbol Ann -> Set Symbol
forall v a. Ord v => TypecheckedUnisonFile v a -> Set v
UF.typeNamespaceBindings TypecheckedUnisonFile Symbol Ann
tuf)))
              DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents0

      -- Hydrate the dependents for rendering
      DefnsF
  (Map Name)
  (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
  (Id' Hash, Decl Symbol Ann)
hydratedDependents <-
        (Hash -> Transaction [(Term Symbol Ann, Type Symbol Ann)])
-> (Hash -> Transaction [Decl Symbol Ann])
-> DefnsF (Map Name) (Id' Hash) (Id' Hash)
-> Transaction
     (DefnsF
        (Map Name)
        (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
        (Id' Hash, Decl Symbol Ann))
forall (m :: * -> *) name term typ.
(Monad m, Ord name) =>
(Hash -> m [term])
-> (Hash -> m [typ])
-> DefnsF (Map name) (Id' Hash) (Id' Hash)
-> m (DefnsF (Map name) (Id' Hash, term) (Id' Hash, typ))
hydrateDefns
          (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 Env
env.codebase)
          HasCallStack => Hash -> Transaction [Decl Symbol Ann]
Hash -> Transaction [Decl Symbol Ann]
Operations.expectDeclComponent
          DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents1

      pure (DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents1, DefnsF
  (Map Name)
  (Id' Hash, (Term Symbol Ann, Type Symbol Ann))
  (Id' Hash, Decl Symbol Ann)
hydratedDependents)

  TypecheckedUnisonFile Symbol Ann
secondTuf <- do
    case DefnsF (Map Name) (Id' Hash) (Id' Hash) -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty DefnsF (Map Name) (Id' Hash) (Id' Hash)
dependents of
      -- If there are no dependents of the updates, then just use the already-typechecked file.
      Bool
True -> TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypecheckedUnisonFile Symbol Ann
tuf
      Bool
False -> do
        Output -> Cli ()
Cli.respond Output
Output.UpdateStartTypechecking

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

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

        TypecheckedUnisonFile Symbol Ann
secondTuf <-
          Pretty ColorText
-> ParsingEnv Transaction
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
parseAndTypecheck Pretty ColorText
prettyUnisonFile ParsingEnv Transaction
parsingEnv Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
    -> Cli (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& Cli (TypecheckedUnisonFile Symbol Ann)
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
            FilePath
scratchFilePath <- (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Bool) -> FilePath)
-> Cli (FilePath, Bool) -> Cli FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (FilePath, Bool)
Cli.expectLatestFile
            IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Env
env.writeSource (FilePath -> Text
Text.pack FilePath
scratchFilePath) (FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Pretty ColorText
prettyUnisonFile)
            Output -> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly Output
Output.UpdateTypecheckingFailure

        Output -> Cli ()
Cli.respond Output
Output.UpdateTypecheckingSuccess

        pure TypecheckedUnisonFile Symbol Ann
secondTuf

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

  Output -> Cli ()
Cli.respond Output
Output.Success

makePrettyUnisonFile :: Pretty ColorText -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText
makePrettyUnisonFile :: Pretty ColorText
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
makePrettyUnisonFile Pretty ColorText
originalFile DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents =
  Pretty ColorText
originalFile
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- The definitions below no longer typecheck with the changes above."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- Please fix the errors and try `update` again."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ( DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents
           DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
    -> DefnsF [] (Pretty ColorText) (Pretty ColorText))
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
forall a b. a -> (a -> b) -> b
& DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder
           DefnsF [] (Pretty ColorText) (Pretty ColorText)
-> (DefnsF [] (Pretty ColorText) (Pretty ColorText)
    -> Pretty ColorText)
-> Pretty ColorText
forall a b. a -> (a -> b) -> b
& let f :: [Pretty ColorText] -> Pretty ColorText
f = (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Pretty ColorText
defn -> Pretty ColorText
defn Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline) in ([Pretty ColorText] -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> DefnsF [] (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap [Pretty ColorText] -> Pretty ColorText
f [Pretty ColorText] -> Pretty ColorText
f
       )
  where
    inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b
    inAlphabeticalOrder :: forall a b. DefnsF (Map Name) a b -> DefnsF [] a b
inAlphabeticalOrder =
      (Map Name a -> [a])
-> (Map Name b -> [b])
-> Defns (Map Name a) (Map Name b)
-> Defns [a] [b]
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map Name a -> [a]
forall {b}. Map Name b -> [b]
f Map Name b -> [b]
forall {b}. Map Name b -> [b]
f
      where
        f :: Map Name b -> [b]
f = ((Name, b) -> b) -> [(Name, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Name, b) -> b
forall a b. (a, b) -> b
snd ([(Name, b)] -> [b])
-> (Map Name b -> [(Name, b)]) -> Map Name b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, b) -> Text) -> [(Name, b)] -> [(Name, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Name -> Text
Name.toText (Name -> Text) -> ((Name, b) -> Name) -> (Name, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> Name
forall a b. (a, b) -> a
fst) ([(Name, b)] -> [(Name, b)])
-> (Map Name b -> [(Name, b)]) -> Map Name b -> [(Name, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name b -> [(Name, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

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

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

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

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

-- | get references from `names` that have the same names as in `defns`
-- For constructors, we get the type reference.
getExistingReferencesNamed :: DefnsF Set Name Name -> Names -> Set Reference
getExistingReferencesNamed :: DefnsF Set Name Name -> Names -> Set TypeReference
getExistingReferencesNamed DefnsF Set Name Name
defns Names
names =
  (Set Name -> Set TypeReference)
-> (Set Name -> Set TypeReference)
-> DefnsF Set Name Name
-> Set TypeReference
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap Set Name -> Set TypeReference
fromTerms Set Name -> Set TypeReference
fromTypes DefnsF Set Name Name
defns
  where
    fromTerms :: Set Name -> Set Reference
    fromTerms :: Set Name -> Set TypeReference
fromTerms =
      (Name -> Set TypeReference) -> Set Name -> Set TypeReference
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \Name
name ->
        (Referent -> TypeReference) -> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> TypeReference
Referent.toReference (Name -> Relation Name Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Name
name (Names -> Relation Name Referent
Names.terms Names
names))

    fromTypes :: Set Name -> Set TypeReference
    fromTypes :: Set Name -> Set TypeReference
fromTypes =
      (Name -> Set TypeReference) -> Set Name -> Set TypeReference
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \Name
name ->
        Name -> Relation Name TypeReference -> Set TypeReference
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Name
name (Names -> Relation Name TypeReference
Names.types Names
names)

-- @getTermAndDeclNames file@ returns the names of the terms and decls defined in a typechecked Unison file.
getTermAndDeclNames :: (Var v) => TypecheckedUnisonFile v a -> DefnsF Set Name Name
getTermAndDeclNames :: forall v a.
Var v =>
TypecheckedUnisonFile v a -> DefnsF Set Name Name
getTermAndDeclNames TypecheckedUnisonFile v a
tuf =
  Set Name -> Set Name -> DefnsF Set Name Name
forall terms types. terms -> types -> Defns terms types
Defns (Set Name
terms Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
effectCtors Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
dataCtors) (Set Name
effects Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
datas)
  where
    terms :: Set Name
terms =
      TypecheckedUnisonFile v a
-> Map v (a, Id' Hash, Maybe FilePath, Term v a, Type v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id' Hash, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile v a
tuf
        Map v (a, Id' Hash, Maybe FilePath, Term v a, Type v a)
-> (Map v (a, Id' Hash, Maybe FilePath, Term v a, Type v a)
    -> Set Name)
-> Set Name
forall a b. a -> (a -> b) -> b
& (v
 -> (a, Id' Hash, Maybe FilePath, Term v a, Type v a) -> Set Name)
-> Map v (a, Id' Hash, Maybe FilePath, Term v a, Type v a)
-> Set Name
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey \v
var (a
_, Id' Hash
_, Maybe FilePath
wk, Term v a
_, Type v a
_) ->
          if Maybe FilePath -> Bool
WK.watchKindShouldBeStoredInDatabase Maybe FilePath
wk
            then Name -> Set Name
forall a. a -> Set a
Set.singleton (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
var)
            else Set Name
forall a. Set a
Set.empty
    effects :: Set Name
effects = Map v (Id' Hash, EffectDeclaration v a) -> Set Name
forall {a}. Map v a -> Set Name
keysToNames (Map v (Id' Hash, EffectDeclaration v a) -> Set Name)
-> Map v (Id' Hash, EffectDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (Id' Hash, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (Id' Hash, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile v a
tuf
    datas :: Set Name
datas = Map v (Id' Hash, DataDeclaration v a) -> Set Name
forall {a}. Map v a -> Set Name
keysToNames (Map v (Id' Hash, DataDeclaration v a) -> Set Name)
-> Map v (Id' Hash, DataDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a -> Map v (Id' Hash, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id' Hash, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile v a
tuf
    effectCtors :: Set Name
effectCtors = (DataDeclaration v a -> Set Name)
-> Map v (DataDeclaration v a) -> Set Name
forall m a. Monoid m => (a -> m) -> Map v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DataDeclaration v a -> Set Name
forall {a}. DataDeclaration v a -> Set Name
ctorsToNames (Map v (DataDeclaration v a) -> Set Name)
-> Map v (DataDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ ((Id' Hash, EffectDeclaration v a) -> DataDeclaration v a)
-> Map v (Id' Hash, EffectDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
Decl.toDataDecl (EffectDeclaration v a -> DataDeclaration v a)
-> ((Id' Hash, EffectDeclaration v a) -> EffectDeclaration v a)
-> (Id' Hash, EffectDeclaration v a)
-> DataDeclaration v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id' Hash, EffectDeclaration v a) -> EffectDeclaration v a
forall a b. (a, b) -> b
snd) (Map v (Id' Hash, EffectDeclaration v a)
 -> Map v (DataDeclaration v a))
-> Map v (Id' Hash, EffectDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (Id' Hash, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (Id' Hash, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile v a
tuf
    dataCtors :: Set Name
dataCtors = (DataDeclaration v a -> Set Name)
-> Map v (DataDeclaration v a) -> Set Name
forall m a. Monoid m => (a -> m) -> Map v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DataDeclaration v a -> Set Name
forall {a}. DataDeclaration v a -> Set Name
ctorsToNames (Map v (DataDeclaration v a) -> Set Name)
-> Map v (DataDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ ((Id' Hash, DataDeclaration v a) -> DataDeclaration v a)
-> Map v (Id' Hash, DataDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Id' Hash, DataDeclaration v a) -> DataDeclaration v a
forall a b. (a, b) -> b
snd (Map v (Id' Hash, DataDeclaration v a)
 -> Map v (DataDeclaration v a))
-> Map v (Id' Hash, DataDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a -> Map v (Id' Hash, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id' Hash, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile v a
tuf
    keysToNames :: Map v a -> Set Name
keysToNames = (v -> Name) -> Set v -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (Set v -> Set Name) -> (Map v a -> Set v) -> Map v a -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v a -> Set v
forall k a. Map k a -> Set k
Map.keysSet
    ctorsToNames :: DataDeclaration v a -> Set Name
ctorsToNames = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name)
-> (DataDeclaration v a -> [Name])
-> DataDeclaration v a
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Name) -> [v] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar ([v] -> [Name])
-> (DataDeclaration v a -> [v]) -> DataDeclaration v a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v a -> [v]
forall v a. DataDeclaration v a -> [v]
Decl.constructorVars

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