-- | @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.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import Text.Builder qualified
import U.Codebase.Reference (Reference, TermReferenceId)
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty qualified as Pretty
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Cli.UpdateUtils (getNamespaceDependentsOf, hydrateRefs, makeUniqueTypeGuids, nameHydratedRefIds, parseAndTypecheck, subtractDependents)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch, Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch
import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch
import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge
import Unison.Codebase.Editor.Output (Output)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.SqliteCodebase.Operations qualified as Operations
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as Decl
import Unison.DeclCoherencyCheck qualified as DeclCoherencyCheck
import Unison.DeclNameLookup (DeclNameLookup (..))
import Unison.Merge qualified as Merge
import Unison.Name (Name)
import Unison.NameSegment qualified as NameSegment
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.Project (ProjectAndBranch (..), projectBranchNameToValidProjectBranchNameText)
import Unison.Reference (TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference (fromId)
import Unison.Referent qualified as Referent
import Unison.Sqlite (Transaction)
import Unison.Symbol (Symbol)
import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile)
import Unison.Syntax.Name qualified as Name
import Unison.UnconflictedLocalDefnsView (UnconflictedLocalDefnsView (..))
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.UnisonFile.Type (TypecheckedUnisonFile)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as Relation
import Unison.WatchKind qualified as WK
import Witch (unsafeFrom)

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

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

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

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

  let namespaceBindings :: DefnsF Set Name Name
      namespaceBindings :: DefnsF Set Name Name
namespaceBindings =
        (Set Symbol -> Set Name)
-> (Set Symbol -> Set Name)
-> Defns (Set Symbol) (Set Symbol)
-> DefnsF Set Name Name
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar) (TypecheckedUnisonFile Symbol Ann -> Defns (Set Symbol) (Set Symbol)
forall v a. Ord v => TypecheckedUnisonFile v a -> DefnsF Set v v
UF.namespaceBindings TypecheckedUnisonFile Symbol Ann
tuf)

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

        (DefnsF (Map Name) TermReferenceId TermReferenceId
dependents, DefnsF Set TermReferenceId TermReferenceId
dependentsRefs, DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedDependents) <-
          Transaction
  (DefnsF (Map Name) TermReferenceId TermReferenceId,
   DefnsF Set TermReferenceId TermReferenceId,
   DefnsF
     (Map Name)
     (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TermReferenceId, Decl Symbol Ann))
-> Cli
     (DefnsF (Map Name) TermReferenceId TermReferenceId,
      DefnsF Set TermReferenceId TermReferenceId,
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
            -- Get all dependents of things being updated
            DefnsF (Map Name) TermReferenceId TermReferenceId
dependents0 <-
              Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Set TypeReference
-> Transaction (DefnsF (Map Name) TermReferenceId TermReferenceId)
getNamespaceDependentsOf
                UnconflictedLocalDefnsView
unconflictedView.defns
                (DefnsF Set Name Name -> Names -> Set TypeReference
getExistingReferencesNamed DefnsF Set Name Name
namespaceBindings UnconflictedLocalDefnsView
unconflictedView.names)

            -- Throw away the dependents that are shadowed by the file itself
            let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId
                dependents1 :: DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1 =
                  (Map Name TermReferenceId -> Map Name TermReferenceId)
-> (Map Name TermReferenceId -> Map Name TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF (Map Name) TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
                    (Map Name TermReferenceId -> Set Name -> Map Name TermReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.terms)
                    (Map Name TermReferenceId -> Set Name -> Map Name TermReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.types)
                    DefnsF (Map Name) TermReferenceId TermReferenceId
dependents0

            let dependentsRefs :: DefnsF Set TermReferenceId TypeReferenceId
                dependentsRefs :: DefnsF Set TermReferenceId TermReferenceId
dependentsRefs =
                  (Map Name TermReferenceId -> Set TermReferenceId)
-> (Map Name TermReferenceId -> Set TermReferenceId)
-> DefnsF (Map Name) TermReferenceId TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) ([TermReferenceId] -> Set TermReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList ([TermReferenceId] -> Set TermReferenceId)
-> (Map Name TermReferenceId -> [TermReferenceId])
-> Map Name TermReferenceId
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name TermReferenceId -> [TermReferenceId]
forall k a. Map k a -> [a]
Map.elems) DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1

            -- Hydrate the dependents for rendering
            Defns
  (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDependents0 <-
              (Hash -> Transaction [(Term Symbol Ann, Type Symbol Ann)])
-> (Hash -> Transaction [Decl Symbol Ann])
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction
     (Defns
        (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann))
        (Map TermReferenceId (Decl Symbol Ann)))
forall (m :: * -> *) term typ.
Monad m =>
(Hash -> m [term])
-> (Hash -> m [typ])
-> DefnsF Set TermReferenceId TermReferenceId
-> m (Defns (Map TermReferenceId term) (Map TermReferenceId typ))
hydrateRefs (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 Set TermReferenceId TermReferenceId
dependentsRefs

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

            (DefnsF (Map Name) TermReferenceId TermReferenceId,
 DefnsF Set TermReferenceId TermReferenceId,
 DefnsF
   (Map Name)
   (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
   (TermReferenceId, Decl Symbol Ann))
-> Transaction
     (DefnsF (Map Name) TermReferenceId TermReferenceId,
      DefnsF Set TermReferenceId TermReferenceId,
      DefnsF
        (Map Name)
        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TermReferenceId, Decl Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefnsF (Map Name) TermReferenceId TermReferenceId
dependents1, DefnsF Set TermReferenceId TermReferenceId
dependentsRefs, DefnsF
  (Map Name)
  (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TermReferenceId, Decl Symbol Ann)
hydratedDependents1)

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

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

              ParsingEnv 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
                  if Bool
useUpdateV2
                    then do
                      let nextNamespace :: Branch IO
                          nextNamespace :: Branch IO
nextNamespace =
                            UnconflictedLocalDefnsView
unconflictedView.defns
                              Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> (Defns
      (BiMultimap Referent Name) (BiMultimap TypeReference Name)
    -> Defns (Map Name Referent) (Map Name TypeReference))
-> Defns (Map Name Referent) (Map Name TypeReference)
forall a b. a -> (a -> b) -> b
& (BiMultimap Referent Name -> Map Name Referent)
-> (BiMultimap TypeReference Name -> Map Name TypeReference)
-> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Defns (Map Name Referent) (Map Name TypeReference)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
                                (BiMultimap Referent Name -> Map Name Referent
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (BiMultimap Referent Name -> Map Name Referent)
-> (Map Name Referent -> Map Name Referent)
-> BiMultimap Referent Name
-> Map Name Referent
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Map Name Referent -> Set Name -> Map Name Referent
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.terms))
                                (BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range (BiMultimap TypeReference Name -> Map Name TypeReference)
-> (Map Name TypeReference -> Map Name TypeReference)
-> BiMultimap TypeReference Name
-> Map Name TypeReference
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Map Name TypeReference -> Set Name -> Map Name TypeReference
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` DefnsF Set Name Name
namespaceBindings.types))
                              Defns (Map Name Referent) (Map Name TypeReference)
-> (Defns (Map Name Referent) (Map Name TypeReference)
    -> Defns (Map Name Referent) (Map Name TypeReference))
-> Defns (Map Name Referent) (Map Name TypeReference)
forall a b. a -> (a -> b) -> b
& DefnsF Set TermReferenceId TermReferenceId
-> Defns (Map Name Referent) (Map Name TypeReference)
-> Defns (Map Name Referent) (Map Name TypeReference)
subtractDependents DefnsF Set TermReferenceId TermReferenceId
dependentsRefs
                              Defns (Map Name Referent) (Map Name TypeReference)
-> (Defns (Map Name Referent) (Map Name TypeReference)
    -> Branch0 IO)
-> Branch0 IO
forall a b. a -> (a -> b) -> b
& Defns (Map Name Referent) (Map Name TypeReference) -> Branch0 IO
forall (m :: * -> *).
Defns (Map Name Referent) (Map Name TypeReference) -> Branch0 m
Branch.fromUnconflictedDefns
                              Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m -> Branch0 m
Branch.setLibdeps (Path -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 (NameSegment -> Path
Path.singleton NameSegment
NameSegment.libSegment) Branch0 IO
currentBranch0)
                              Branch0 IO -> (Branch0 IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& (Branch0 IO -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
`Branch.cons` Branch IO
currentBranch)

                      if ProjectPath
pp.branch.isUpdate Bool -> Bool -> Bool
|| ProjectPath
pp.branch.isUpgrade
                        then do
                          ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
Cli.updateProjectBranchRoot_ ProjectPath
pp.branch Text
"update" (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
nextNamespace)
                          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) Bool
True
                          Output -> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
done Output
Output.UpdateTypecheckingFailure
                        else do
                          Map Name Text
uniqueTypeGuidsByName <-
                            Transaction (Map Name Text) -> Cli (Map Name Text)
forall a. Transaction a -> Cli a
Cli.runTransaction (Map Name TypeReference -> Transaction (Map Name Text)
makeUniqueTypeGuids (BiMultimap TypeReference Name -> Map Name TypeReference
forall a b. BiMultimap a b -> Map b a
BiMultimap.range UnconflictedLocalDefnsView
unconflictedView.defns.types))

                          (ProjectAndBranch ProjectId ProjectBranchId
_updateBranchId, ProjectBranchName
updateBranchName) <-
                            Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
HandleInput.Branch.createBranch
                              (Text
"update " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectPath
pp.project.name ProjectPath
pp.branch.name))
                              ( (ProjectBranch, CausalHash, Map Name Text)
-> Branch IO -> CreateFrom
HandleInput.Branch.CreateFrom'Update
                                  (ProjectPath
pp.branch, Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
currentBranch, Map Name Text
uniqueTypeGuidsByName)
                                  Branch IO
nextNamespace
                              )
                              ProjectPath
pp.project
                              ( ProjectId -> ProjectBranchName -> Transaction ProjectBranchName
ProjectUtils.findTemporaryBranchName
                                  ProjectId
projectId
                                  ( (Builder
"update-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Builder
projectBranchNameToValidProjectBranchNameText ProjectPath
pp.branch.name)
                                      Builder -> (Builder -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Builder -> Text
Text.Builder.run
                                      Text -> (Text -> ProjectBranchName) -> ProjectBranchName
forall a b. a -> (a -> b) -> b
& forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text
                                  )
                              )
                          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
                          #latestFile ?= (scratchFilePath, True)
                          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) Bool
True
                          Output -> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
done (FilePath -> ProjectBranchName -> ProjectBranchName -> Output
Output.UpdateTypecheckingFailure2 FilePath
scratchFilePath ProjectPath
pp.branch.name ProjectBranchName
updateBranchName)
                    else 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
                      #latestFile ?= (scratchFilePath, True)
                      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) Bool
True
                      Output -> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
done Output
Output.UpdateTypecheckingFailure

              Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pretty.wrap Pretty ColorText
"Everything typechecks, so I'm saving the results..."))

              TypecheckedUnisonFile Symbol Ann
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
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

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

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

            TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli ()
Merge.doMergeLocalBranch
              Merge.TwoWay
                { $sel:alice:TwoWay :: ProjectAndBranch Project ProjectBranch
alice = Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectPath
pp.project ProjectBranch
parentBranch,
                  $sel:bob:TwoWay :: ProjectAndBranch Project ProjectBranch
bob = Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectPath
pp.project ProjectPath
pp.branch
                }

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

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

        Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Output
Output.Success

  Output -> Cli ()
Cli.respond Output
finalOutput

makePrettyUnisonFile :: Pretty ColorText -> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> Pretty ColorText
makePrettyUnisonFile :: Pretty ColorText
-> DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
-> Pretty ColorText
makePrettyUnisonFile Pretty ColorText
originalFile DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)
dependents =
  Pretty ColorText
originalFile
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- The definitions below no longer typecheck with the changes above."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- Please fix the errors and try `update` again."
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
Pretty.newline
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ( 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
  [(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)]
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, (TermReferenceId, DataDeclaration Symbol Ann))
 -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
Monoid.foldMapM (Symbol, (TermReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
 -> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))])
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, DataDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
      [(Path, Branch0 m -> Branch0 m)]
effectDeclUpdates <- ((Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
 -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TermReferenceId, 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, (TermReferenceId, EffectDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
 -> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))])
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
      [(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)]
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, (TermReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann
dataDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
dataDecl))
        makeEffectDeclUpdates :: (Symbol, (TermReferenceId, EffectDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann
effectDecl)) = (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left EffectDeclaration Symbol Ann
effectDecl))

        makeDeclUpdates :: (Symbol, (TypeReferenceId, Decl Symbol Ann)) -> Transaction [(Path, Branch0 m -> Branch0 m)]
        makeDeclUpdates :: (Symbol, (TermReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TermReferenceId
typeRefId, Decl Symbol Ann
decl)) = do
          -- some decls will be deleted, we want to delete their
          -- constructors as well
          [(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 -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTermName (Split Path -> (Path, Branch0 m -> Branch0 m))
-> (Name -> Split Path) -> Name -> (Path, Branch0 m -> Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split Path
Path.splitFromName))
                (Maybe [Name] -> [(Path, Branch0 m -> Branch0 m)])
-> Either Output (Maybe [Name])
-> Either Output [(Path, Branch0 m -> Branch0 m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Either Output (Maybe [Name])
getConstructors (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
symbol)
              )
              Either Output [(Path, Branch0 m -> Branch0 m)]
-> (Either Output [(Path, Branch0 m -> Branch0 m)]
    -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall a b. a -> (a -> b) -> b
& (Output -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> Either Output [(Path, Branch0 m -> Branch0 m)]
-> Transaction [(Path, Branch0 m -> Branch0 m)]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft Output -> Transaction [(Path, Branch0 m -> Branch0 m)]
forall void. Output -> Transaction void
abort
          let deleteTypeAction :: (Path, Branch0 m -> Branch0 m)
deleteTypeAction = Split Path -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTypeName Split Path
split
              split :: Split Path
split = Symbol -> Split Path
splitVar Symbol
symbol
              insertTypeAction :: (Path, Branch0 m -> Branch0 m)
insertTypeAction = Split Path -> TypeReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split Path
split (TermReferenceId -> TypeReference
Reference.fromId TermReferenceId
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)) (TermReferenceId -> Decl Symbol Ann -> [Id]
forall v a. TermReferenceId -> Decl v a -> [Id]
Decl.declConstructorReferents TermReferenceId
typeRefId Decl Symbol Ann
decl)
                 in ((Symbol, Id) -> (Path, Branch0 m -> Branch0 m))
-> [(Symbol, Id)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map
                      ( \(Symbol
sym, Id
rid) ->
                          let splitConName :: Split Path
splitConName = Symbol -> Split Path
splitVar Symbol
sym
                           in Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Path
splitConName (TermReferenceId -> TypeReference
Reference.fromId (TermReferenceId -> 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, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId
        Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> (Map
      Symbol
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann)
    -> [(Symbol,
         (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))])
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map
  Symbol
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))]
-> ([(Symbol,
      (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann))]
    -> [(Path, Branch0 m -> Branch0 m)])
-> [(Path, Branch0 m -> Branch0 m)]
forall a b. a -> (a -> b) -> b
& ((Symbol,
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol,
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
-> [(Path, Branch0 m -> Branch0 m)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Symbol
var, (Ann
_, TermReferenceId
ref, Maybe FilePath
wk, Term Symbol Ann
_, Type Symbol Ann
_)) ->
          if Maybe FilePath -> Bool
WK.watchKindShouldBeStoredInDatabase Maybe FilePath
wk
            then
              let split :: Split Path
split = Symbol -> Split Path
splitVar Symbol
var
               in [ Split Path -> (Path, Branch0 m -> Branch0 m)
forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
BranchUtil.makeAnnihilateTermName Split Path
split,
                    Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Path
split (TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
ref)
                  ]
            else []

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

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

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