-- | @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 System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import Text.Builder qualified
import U.Codebase.Decl qualified as V2.Decl
import U.Codebase.Reference (Reference, Reference' (..), TermReferenceId)
import U.Codebase.Sqlite.Operations qualified as Operations
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 (getNamespaceDependentsOf2, hydrateDefns, 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.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.ConstructorReference (GConstructorReference (..))
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.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Project (ProjectAndBranch (..), projectBranchNameToValidProjectBranchNameText)
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 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.Var (Var)
import Unison.WatchKind qualified as WK
import Witch (unsafeFrom)

useUpdateV2 :: Bool
useUpdateV2 :: Bool
useUpdateV2 =
  Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe FilePath) -> Maybe FilePath
forall a. IO a -> a
unsafePerformIO (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"UNISON_USE_UPDATE_V2"))
{-# 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
  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
  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, and get whether we are on an "update" branch already
  UnconflictedBranchView
unconflictedView <-
    Branch0 IO
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedBranchView
forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedBranchView
Branch.asUnconflicted Branch0 IO
currentBranch0
      Either
  (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
  UnconflictedBranchView
-> (Either
      (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
      UnconflictedBranchView
    -> Cli UnconflictedBranchView)
-> Cli UnconflictedBranchView
forall a b. a -> (a -> b) -> b
& (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
 -> Cli UnconflictedBranchView)
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedBranchView
-> Cli UnconflictedBranchView
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft (Output -> Cli UnconflictedBranchView
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli UnconflictedBranchView)
-> (Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
    -> Output)
-> Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
-> Cli UnconflictedBranchView
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, Bool
onUpdateBranchAlready) <-
    ((forall void. Output -> Transaction void)
 -> Transaction (DeclNameLookup, Bool))
-> Cli (DeclNameLookup, Bool)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
      DeclNameLookup
declNameLookup <-
        Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedBranchView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedBranchView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
Codebase.getBranchDeclNameLookup Env
env.codebase (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentBranch) UnconflictedBranchView
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)
      Bool
onUpdateBranchAlready <- ProjectId -> ProjectBranchId -> Transaction Bool
Queries.projectBranchIsUpdateBranch ProjectId
projectId ProjectPath
pp.branch.branchId
      (DeclNameLookup, Bool) -> Transaction (DeclNameLookup, Bool)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeclNameLookup
declNameLookup, Bool
onUpdateBranchAlready)

  let fileTermNamespaceBindings :: Set Name
      fileTermNamespaceBindings :: Set Name
fileTermNamespaceBindings =
        (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)

  let fileTypeNamespaceBindings :: Set Name
      fileTypeNamespaceBindings :: Set Name
fileTypeNamespaceBindings =
        (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)

  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) TypeReferenceId TypeReferenceId
dependents, DefnsF
  (Map Name)
  (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TypeReferenceId, Decl Symbol Ann)
hydratedDependents) <-
          Transaction
  (DefnsF (Map Name) TypeReferenceId TypeReferenceId,
   DefnsF
     (Map Name)
     (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TypeReferenceId, Decl Symbol Ann))
-> Cli
     (DefnsF (Map Name) TypeReferenceId TypeReferenceId,
      DefnsF
        (Map Name)
        (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TypeReferenceId, Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction do
            -- Get all dependents of things being updated
            DefnsF (Map Name) TypeReferenceId TypeReferenceId
dependents0 <-
              Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)
-> Set TypeReference
-> Transaction (DefnsF (Map Name) TypeReferenceId TypeReferenceId)
getNamespaceDependentsOf2
                UnconflictedBranchView
unconflictedView.defns
                (DefnsF Set Name Name -> Names -> Set TypeReference
getExistingReferencesNamed DefnsF Set Name Name
termAndDeclNames UnconflictedBranchView
unconflictedView.names)

            -- Throw away the dependents that are shadowed by the file itself
            let dependents1 :: DefnsF (Map Name) TermReferenceId TypeReferenceId
                dependents1 :: DefnsF (Map Name) TypeReferenceId TypeReferenceId
dependents1 =
                  (Map Name TypeReferenceId -> Map Name TypeReferenceId)
-> (Map Name TypeReferenceId -> Map Name TypeReferenceId)
-> DefnsF (Map Name) TypeReferenceId TypeReferenceId
-> DefnsF (Map Name) TypeReferenceId TypeReferenceId
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 TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set Name
fileTermNamespaceBindings)
                    (Map Name TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set Name
fileTypeNamespaceBindings)
                    DefnsF (Map Name) TypeReferenceId TypeReferenceId
dependents0

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

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

        TypecheckedUnisonFile Symbol Ann
secondTuf <- do
          case DefnsF (Map Name) TypeReferenceId TypeReferenceId -> Bool
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty DefnsF (Map Name) TypeReferenceId TypeReferenceId
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) TypeReferenceId TypeReferenceId
-> 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) TypeReferenceId TypeReferenceId
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)
     (TypeReferenceId, 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) (TypeReferenceId, 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)
     (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TypeReferenceId, Decl Symbol Ann))
  (DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TypeReferenceId, Decl Symbol Ann))
  (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (Term Symbol Ann, Type Symbol Ann)
-> ((TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> (Term Symbol Ann, Type Symbol Ann))
-> DefnsF
     (Map Name)
     (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TypeReferenceId, Decl Symbol Ann)
-> DefnsF
     (Map Name)
     (Term Symbol Ann, Type Symbol Ann)
     (TypeReferenceId, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Map Name (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> DefnsF
     (Map Name)
     (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (TypeReferenceId, Decl Symbol Ann)
-> Identity
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TypeReferenceId, Decl Symbol Ann))
#terms ((Map Name (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
  -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
 -> DefnsF
      (Map Name)
      (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
      (TypeReferenceId, Decl Symbol Ann)
 -> Identity
      (DefnsF
         (Map Name)
         (Term Symbol Ann, Type Symbol Ann)
         (TypeReferenceId, Decl Symbol Ann)))
-> (((TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     -> Identity (Term Symbol Ann, Type Symbol Ann))
    -> Map Name (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
    -> Identity (Map Name (Term Symbol Ann, Type Symbol Ann)))
-> ASetter
     (DefnsF
        (Map Name)
        (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
        (TypeReferenceId, Decl Symbol Ann))
     (DefnsF
        (Map Name)
        (Term Symbol Ann, Type Symbol Ann)
        (TypeReferenceId, Decl Symbol Ann))
     (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
     (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
 -> Identity (Term Symbol Ann, Type Symbol Ann))
-> Map Name (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> Identity (Map Name (Term Symbol Ann, Type Symbol Ann))
Setter
  (Map Name (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann)))
  (Map Name (Term Symbol Ann, Type Symbol Ann))
  (TypeReferenceId, (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) (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
-> (Term Symbol Ann, Type Symbol Ann)
forall a b. (a, b) -> b
snd DefnsF
  (Map Name)
  (TypeReferenceId, (Term Symbol Ann, Type Symbol Ann))
  (TypeReferenceId, 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 dependentRefs :: DefnsF Set TermReferenceId TypeReferenceId
                          dependentRefs :: DefnsF Set TypeReferenceId TypeReferenceId
dependentRefs =
                            (Map Name TypeReferenceId -> Set TypeReferenceId)
-> (Map Name TypeReferenceId -> Set TypeReferenceId)
-> DefnsF (Map Name) TypeReferenceId TypeReferenceId
-> DefnsF Set TypeReferenceId TypeReferenceId
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 TypeReferenceId -> [TypeReferenceId]
forall k a. Map k a -> [a]
Map.elems (Map Name TypeReferenceId -> [TypeReferenceId])
-> ([TypeReferenceId] -> Set TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [TypeReferenceId] -> Set TypeReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList) (Map Name TypeReferenceId -> [TypeReferenceId]
forall k a. Map k a -> [a]
Map.elems (Map Name TypeReferenceId -> [TypeReferenceId])
-> ([TypeReferenceId] -> Set TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [TypeReferenceId] -> Set TypeReferenceId
forall a. Ord a => [a] -> Set a
Set.fromList) DefnsF (Map Name) TypeReferenceId TypeReferenceId
dependents

                      let namespaceWithoutDependents :: Branch0 IO
                          namespaceWithoutDependents :: Branch0 IO
namespaceWithoutDependents =
                            let keepType :: TypeReference -> Bool
                                keepType :: TypeReference -> Bool
keepType = \case
                                  ReferenceBuiltin Text
_ -> Bool
True
                                  ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependentRefs.types)
                                keepTerm :: Referent -> Bool
                                keepTerm :: Referent -> Bool
keepTerm = \case
                                  Referent.Con (ConstructorReference TypeReference
ref ConstructorId
_) ConstructorType
_ -> TypeReference -> Bool
keepType TypeReference
ref
                                  Referent.Ref TypeReference
ref ->
                                    case TypeReference
ref of
                                      ReferenceBuiltin Text
_ -> Bool
True
                                      ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependentRefs.terms)
                             in UnconflictedBranchView
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` Set Name
fileTermNamespaceBindings)
                                        (Map Name Referent -> Map Name Referent)
-> (Map Name Referent -> Map Name Referent)
-> Map Name Referent
-> 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
>>> (Referent -> Bool) -> Map Name Referent -> Map Name Referent
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Referent -> Bool
keepTerm
                                    )
                                    ( 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` Set Name
fileTypeNamespaceBindings)
                                        (Map Name TypeReference -> Map Name TypeReference)
-> (Map Name TypeReference -> Map Name TypeReference)
-> Map Name TypeReference
-> 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
>>> (TypeReference -> Bool)
-> Map Name TypeReference -> Map Name TypeReference
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TypeReference -> Bool
keepType
                                    )
                                  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
                                    ( Branch0 IO
currentBranch0
                                        Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& Path -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 (NameSegment -> Path
Path.singleton NameSegment
NameSegment.libSegment)
                                    )

                      let nextNamespace :: Branch IO
nextNamespace =
                            Branch0 IO -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
Branch.cons Branch0 IO
namespaceWithoutDependents Branch IO
currentBranch

                      if Bool
onUpdateBranchAlready
                        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 UnconflictedBranchView
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 branch that has a parent (an update branch
        -- only won't have a parent if the parent has been deleted for some reason).
        case (Bool
onUpdateBranchAlready, 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 update 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

-- Make a unique type name to guid mapping from definitions, by looking up each decl individually. Maybe there will be
-- a more efficient way to accomplish this some day, but this is how it works for now.
makeUniqueTypeGuids :: Map Name TypeReference -> Transaction (Map Name Text)
makeUniqueTypeGuids :: Map Name TypeReference -> Transaction (Map Name Text)
makeUniqueTypeGuids Map Name TypeReference
types = do
  let step :: Map TypeReferenceId Text -> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
      step :: Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
acc TypeReferenceId
refId = do
        Decl Symbol
decl <- TypeReferenceId -> Transaction (Decl Symbol)
Operations.expectDeclByReference TypeReferenceId
refId
        Map TypeReferenceId Text -> Transaction (Map TypeReferenceId Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Decl Symbol
decl.modifier of
          V2.Decl.Unique Text
guid -> TypeReferenceId
-> Text -> Map TypeReferenceId Text -> Map TypeReferenceId Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TypeReferenceId
refId Text
guid Map TypeReferenceId Text
acc
          Modifier
V2.Decl.Structural -> Map TypeReferenceId Text
acc

  Map TypeReferenceId Text
uniqueTypeGuidsByRef <-
    (Map TypeReferenceId Text
 -> TypeReferenceId -> Transaction (Map TypeReferenceId Text))
-> Map TypeReferenceId Text
-> Set TypeReferenceId
-> Transaction (Map TypeReferenceId Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
forall k a. Map k a
Map.empty ((TypeReference -> Set TypeReferenceId)
-> Map Name TypeReference -> Set TypeReferenceId
forall m a. Monoid m => (a -> m) -> Map Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeReference -> Set TypeReferenceId
toRefIds Map Name TypeReference
types)

  let refToUniqueTypeGuid :: TypeReference -> Maybe Text
      refToUniqueTypeGuid :: TypeReference -> Maybe Text
refToUniqueTypeGuid = \case
        ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Map TypeReferenceId Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReferenceId
refId Map TypeReferenceId Text
uniqueTypeGuidsByRef
        ReferenceBuiltin Text
_ -> Maybe Text
forall a. Maybe a
Nothing

  Map Name Text -> Transaction (Map Name Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TypeReference -> Maybe Text)
-> Map Name TypeReference -> Map Name Text
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe TypeReference -> Maybe Text
refToUniqueTypeGuid Map Name TypeReference
types)
  where
    toRefIds :: TypeReference -> Set TypeReferenceId
    toRefIds :: TypeReference -> Set TypeReferenceId
toRefIds = \case
      ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Set TypeReferenceId
forall a. a -> Set a
Set.singleton TypeReferenceId
refId
      ReferenceBuiltin Text
_ -> Set TypeReferenceId
forall a. Set a
Set.empty

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, (TypeReferenceId, DataDeclaration Symbol Ann))
 -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TypeReferenceId, 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, (TypeReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
 -> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))])
-> Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
tuf)
      [(Path, Branch0 m -> Branch0 m)]
effectDeclUpdates <- ((Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
 -> Transaction [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol, (TypeReferenceId, 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, (TypeReferenceId, EffectDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
 -> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))])
-> Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, 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, (TypeReferenceId, DataDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDataDeclUpdates (Symbol
symbol, (TypeReferenceId
typeRefId, DataDeclaration Symbol Ann
dataDecl)) = (Symbol, (TypeReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TypeReferenceId
typeRefId, DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
dataDecl))
        makeEffectDeclUpdates :: (Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeEffectDeclUpdates (Symbol
symbol, (TypeReferenceId
typeRefId, EffectDeclaration Symbol Ann
effectDecl)) = (Symbol, (TypeReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TypeReferenceId
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, (TypeReferenceId, Decl Symbol Ann))
-> Transaction [(Path, Branch0 m -> Branch0 m)]
makeDeclUpdates (Symbol
symbol, (TypeReferenceId
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 (TypeReferenceId -> TypeReference
Reference.fromId TypeReferenceId
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)) (TypeReferenceId -> Decl Symbol Ann -> [Id]
forall v a. TypeReferenceId -> Decl v a -> [Id]
Decl.declConstructorReferents TypeReferenceId
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 (TypeReferenceId -> TypeReference
Reference.fromId (TypeReferenceId -> 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, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))
-> Map
     Symbol
     (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId
        Map
  Symbol
  (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> (Map
      Symbol
      (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
       Type Symbol Ann)
    -> [(Symbol,
         (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
          Type Symbol Ann))])
-> [(Symbol,
     (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map
  Symbol
  (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> [(Symbol,
     (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Symbol,
  (Ann, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))]
-> ([(Symbol,
      (Ann, TypeReferenceId, 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, TypeReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann))
 -> [(Path, Branch0 m -> Branch0 m)])
-> [(Symbol,
     (Ann, TypeReferenceId, 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
_, TypeReferenceId
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 (TypeReferenceId -> Referent
Referent.fromTermReferenceId TypeReferenceId
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)

-- @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, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile v a
tuf
        Map v (a, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
-> (Map v (a, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
    -> Set Name)
-> Set Name
forall a b. a -> (a -> b) -> b
& (v
 -> (a, TypeReferenceId, Maybe FilePath, Term v a, Type v a)
 -> Set Name)
-> Map v (a, TypeReferenceId, 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
_, TypeReferenceId
_, 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 (TypeReferenceId, EffectDeclaration v a) -> Set Name
forall {a}. Map v a -> Set Name
keysToNames (Map v (TypeReferenceId, EffectDeclaration v a) -> Set Name)
-> Map v (TypeReferenceId, EffectDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile v a
tuf
    datas :: Set Name
datas = Map v (TypeReferenceId, DataDeclaration v a) -> Set Name
forall {a}. Map v a -> Set Name
keysToNames (Map v (TypeReferenceId, DataDeclaration v a) -> Set Name)
-> Map v (TypeReferenceId, DataDeclaration v a) -> Set Name
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, 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
$ ((TypeReferenceId, EffectDeclaration v a) -> DataDeclaration v a)
-> Map v (TypeReferenceId, 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)
-> ((TypeReferenceId, EffectDeclaration v a)
    -> EffectDeclaration v a)
-> (TypeReferenceId, EffectDeclaration v a)
-> DataDeclaration v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId, EffectDeclaration v a) -> EffectDeclaration v a
forall a b. (a, b) -> b
snd) (Map v (TypeReferenceId, EffectDeclaration v a)
 -> Map v (DataDeclaration v a))
-> Map v (TypeReferenceId, EffectDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, 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
$ ((TypeReferenceId, DataDeclaration v a) -> DataDeclaration v a)
-> Map v (TypeReferenceId, 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 (TypeReferenceId, DataDeclaration v a) -> DataDeclaration v a
forall a b. (a, b) -> b
snd (Map v (TypeReferenceId, DataDeclaration v a)
 -> Map v (DataDeclaration v a))
-> Map v (TypeReferenceId, DataDeclaration v a)
-> Map v (DataDeclaration v a)
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TypeReferenceId, 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) TypeReferenceId TypeReferenceId
-> PrettyPrintEnvDecl
makePPE Int
hashLen Names
namespaceNames Names
initialFileNames DefnsF (Map Name) TypeReferenceId TypeReferenceId
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) TypeReferenceId TypeReferenceId -> Names
Names.fromUnconflictedReferenceIds DefnsF (Map Name) TypeReferenceId TypeReferenceId
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))
    )