Merge pull request #4579 from unisonweb/cp/remove-global-names-again

Scope all commands to current namespace (no global fallbacks for names or PPE)

parser-typechecker/src/Unison/Codebase.hs

@@ -44,6 +44,7 @@ module Unison.Codebase
     SqliteCodebase.Operations.before,
     getShallowBranchAtPath,
     getShallowCausalAtPath,
+    getBranchAtPath,
     Operations.expectCausalBranchByCausalHash,
     getShallowCausalFromRoot,
     getShallowRootBranch,
@@ -115,7 +116,6 @@ where
 
 import Control.Monad.Except (ExceptT (ExceptT), runExceptT)
 import Control.Monad.Trans.Except (throwE)
-import Data.List as List
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import U.Codebase.Branch qualified as V2
@@ -242,23 +242,15 @@ getShallowBranchAtPath path mayBranch = do
           childBranch <- V2Causal.value childCausal
           getShallowBranchAtPath p (Just childBranch)
 
--- | Get a branch from the codebase.
-getBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Maybe (Branch m))
-getBranchForHash codebase h =
-  -- Attempt to find the Branch in the current codebase cache and root up to 3 levels deep
-  -- If not found, attempt to find it in the Codebase (sqlite)
-  let nestedChildrenForDepth :: Int -> Branch m -> [Branch m]
-      nestedChildrenForDepth depth b =
-        if depth == 0
-          then []
-          else b : (Map.elems (Branch._children (Branch.head b)) >>= nestedChildrenForDepth (depth - 1))
-
-      headHashEq = (h ==) . Branch.headHash
-
-      find rb = List.find headHashEq (nestedChildrenForDepth 3 rb)
-   in do
-        rootBranch <- getRootBranch codebase
-        maybe (getBranchForHashImpl codebase h) (pure . Just) (find rootBranch)
+-- | Get a v1 branch from the root following the given path.
+getBranchAtPath ::
+  (MonadIO m) =>
+  Codebase m v a ->
+  Path.Absolute ->
+  m (Branch m)
+getBranchAtPath codebase path = do
+  V2Causal.Causal {causalHash} <- runTransaction codebase $ getShallowCausalAtPath (Path.unabsolute path) Nothing
+  expectBranchForHash codebase causalHash
 
 -- | Like 'getBranchForHash', but for when the hash is known to be in the codebase.
 expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m)

parser-typechecker/src/Unison/Codebase/Branch/Names.hs

@@ -1,15 +1,26 @@
 module Unison.Codebase.Branch.Names
   ( namesDiff,
     toNames,
+    toPrettyPrintEnvDecl,
   )
 where
 
 import Unison.Codebase.Branch
 import Unison.Names (Names (..))
 import Unison.NamesWithHistory qualified as Names
+import Unison.PrettyPrintEnv.Names qualified as PPE
+import Unison.PrettyPrintEnvDecl qualified as PPED
+import Unison.PrettyPrintEnvDecl.Names qualified as PPED
 import Unison.Util.Relation qualified as R
 import Prelude hiding (head, read, subtract)
 
+-- | Get the pretty-printing environment for names in the provided branch.
+toPrettyPrintEnvDecl :: Int -> Branch0 m -> PPED.PrettyPrintEnvDecl
+toPrettyPrintEnvDecl hashLength b =
+  let names = toNames b
+   in PPED.makePPED (PPE.hqNamer hashLength names) (PPE.suffixifyByHash names)
+
+-- | Get the names in the provided branch.
 toNames :: Branch0 m -> Names
 toNames b =
   Names

parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs

@@ -381,7 +381,7 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
                   getTermComponentWithTypes,
                   getRootBranch,
                   putRootBranch,
-                  getBranchForHashImpl = getBranchForHash,
+                  getBranchForHash,
                   putBranch,
                   syncFromDirectory,
                   syncToDirectory,

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs

@@ -50,7 +50,6 @@ import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment (..))
 import Unison.Names (Names (Names))
 import Unison.Names qualified as Names
-import Unison.Names.Scoped (ScopedNames (..))
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.Reference (Reference)
@@ -518,7 +517,7 @@ filterReferentsHavingTypeImpl ::
 filterReferentsHavingTypeImpl doGetDeclType typRef termRefs =
   Ops.filterTermsByReferentHavingType (Cv.reference1to2 typRef) (Cv.referentid1to2 <$> toList termRefs)
     >>= traverse (Cv.referentid2to1 doGetDeclType)
-      <&> Set.fromList
+    <&> Set.fromList
 
 -- | The number of base32 characters needed to distinguish any two references in the codebase.
 hashLength :: Transaction Int
@@ -588,30 +587,23 @@ namesAtPath ::
   BranchHash ->
   -- Include names from the project which contains this path.
   Path ->
-  Transaction ScopedNames
+  Transaction Names
 namesAtPath bh path = do
   let namesRoot = PathSegments . coerce . Path.toList $ path
   namesPerspective@Ops.NamesPerspective {relativePerspective} <- Ops.namesPerspectiveForRootAndPath bh namesRoot
   let relativePath = Path.fromList $ coerce relativePerspective
   NamesInPerspective {termNamesInPerspective, typeNamesInPerspective} <- Ops.allNamesInPerspective namesPerspective
   let termsInPath = convertTerms termNamesInPerspective
   let typesInPath = convertTypes typeNamesInPerspective
-  let rootTerms = Rel.fromList termsInPath
-  let rootTypes = Rel.fromList typesInPath
-  let absoluteRootNames = Names.makeAbsolute $ Names {terms = rootTerms, types = rootTypes}
   let relativeScopedNames =
         case relativePath of
-          Path.Empty -> (Names.makeRelative $ absoluteRootNames)
+          Path.Empty -> (Names {terms = Rel.fromList termsInPath, types = Rel.fromList typesInPath})
           p ->
             let reversedPathSegments = reverse . Path.toList $ p
                 relativeTerms = mapMaybe (stripPathPrefix reversedPathSegments) termsInPath
                 relativeTypes = mapMaybe (stripPathPrefix reversedPathSegments) typesInPath
              in (Names {terms = Rel.fromList relativeTerms, types = Rel.fromList relativeTypes})
-  pure $
-    ScopedNames
-      { relativeScopedNames,
-        absoluteRootNames
-      }
+  pure $ relativeScopedNames
   where
     convertTypes names =
       names <&> \(S.NamedRef {reversedSegments, ref}) ->

parser-typechecker/src/Unison/Codebase/Type.hs

@@ -79,7 +79,7 @@ data Codebase m v a = Codebase
       Text -> -- Reason for the change, will be recorded in the reflog
       Branch m ->
       m (),
-    getBranchForHashImpl :: CausalHash -> m (Maybe (Branch m)),
+    getBranchForHash :: CausalHash -> m (Maybe (Branch m)),
     -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't
     -- already exist.
     --

parser-typechecker/src/Unison/PrettyPrintEnvDecl.hs

@@ -37,6 +37,8 @@ biasTo targets PrettyPrintEnvDecl {unsuffixifiedPPE, suffixifiedPPE} =
 empty :: PrettyPrintEnvDecl
 empty = PrettyPrintEnvDecl PPE.empty PPE.empty
 
+-- | Will use names from the fallback pped if no names were found in the primary.
+-- @addFallback primary fallback@
 addFallback :: PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
 addFallback (PrettyPrintEnvDecl unsuff1 suff1) (PrettyPrintEnvDecl unsuff2 suff2) =
   PrettyPrintEnvDecl (unsuff1 `PPE.addFallback` unsuff2) (suff1 `PPE.addFallback` suff2)

parser-typechecker/src/Unison/UnisonFile/Names.hs

@@ -9,20 +9,21 @@ import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..))
 import Unison.DataDeclaration qualified as DD
 import Unison.DataDeclaration.Names qualified as DD.Names
 import Unison.Hashing.V2.Convert qualified as Hashing
+import Unison.Name qualified as Name
 import Unison.Names (Names (..))
 import Unison.Names.ResolutionResult qualified as Names
+import Unison.NamesWithHistory qualified as Names
 import Unison.Prelude
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
-import Unison.Name qualified as Name
 import Unison.Syntax.Name qualified as Name
 import Unison.Term qualified as Term
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Env (Env (..))
 import Unison.UnisonFile.Error (Error (DupDataAndAbility, UnknownType))
 import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId), UnisonFile (UnisonFileId))
-import Unison.Util.Relation qualified as Relation
 import Unison.Util.List qualified as List
+import Unison.Util.Relation qualified as Relation
 import Unison.Var (Var)
 import Unison.Var qualified as Var
 import Unison.WatchKind qualified as WK
@@ -33,6 +34,9 @@ toNames uf = datas <> effects
     datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeFromVar) (Map.toList (UF.dataDeclarationsId uf))
     effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeFromVar) (Map.toList (UF.effectDeclarationsId uf))
 
+addNamesFromUnisonFile :: (Var v) => UnisonFile v a -> Names -> Names
+addNamesFromUnisonFile unisonFile names = Names.shadowing (toNames unisonFile) names
+
 typecheckedToNames :: (Var v) => TypecheckedUnisonFile v a -> Names
 typecheckedToNames uf = Names (terms <> ctors) types
   where
@@ -57,6 +61,9 @@ typecheckedToNames uf = Names (terms <> ctors) types
         . UF.hashConstructors
         $ uf
 
+addNamesFromTypeCheckedUnisonFile :: (Var v) => TypecheckedUnisonFile v a -> Names -> Names
+addNamesFromTypeCheckedUnisonFile unisonFile names = Names.shadowing (typecheckedToNames unisonFile) names
+
 typecheckedUnisonFile0 :: (Ord v) => TypecheckedUnisonFile v a
 typecheckedUnisonFile0 = TypecheckedUnisonFileId Map.empty Map.empty mempty mempty mempty
 
@@ -100,15 +107,15 @@ bindNames names (UnisonFileId d e ts ws) = do
 --
 -- It's used below in `environmentFor` and also during the term resolution
 -- process.
-variableCanonicalizer :: forall v . Var v => [v] -> Map v v
+variableCanonicalizer :: forall v. Var v => [v] -> Map v v
 variableCanonicalizer vs =
   done $ List.multimap do
     v <- vs
     let n = Name.unsafeFromVar v
     suffix <- Name.suffixes n
     pure (Var.named (Name.toText suffix), v)
   where
-    done xs = Map.fromList [ (k, v) | (k, nubOrd -> [v]) <- Map.toList xs ] <> Map.fromList [(v,v) | v <- vs]
+    done xs = Map.fromList [(k, v) | (k, nubOrd -> [v]) <- Map.toList xs] <> Map.fromList [(v, v) | v <- vs]
 
 -- This function computes hashes for data and effect declarations, and
 -- also returns a function for resolving strings to (Reference, ConstructorId)

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -75,7 +75,7 @@ module Unison.Cli.MonadUtils
     -- * Latest touched Unison file
     getLatestFile,
     getLatestParsedFile,
-    getNamesFromLatestParsedFile,
+    getNamesFromLatestFile,
     getTermFromLatestParsedFile,
     expectLatestFile,
     expectLatestParsedFile,
@@ -258,7 +258,8 @@ modifyRootBranch f = do
 getCurrentBranch :: Cli (Branch IO)
 getCurrentBranch = do
   path <- getCurrentPath
-  getBranchAt path
+  Cli.Env {codebase} <- ask
+  liftIO $ Codebase.getBranchAtPath codebase path
 
 -- | Get the current branch0.
 getCurrentBranch0 :: Cli (Branch0 IO)
@@ -573,12 +574,14 @@ getTermFromLatestParsedFile (HQ.NameOnly n) = do
         _ -> Nothing
 getTermFromLatestParsedFile _ = pure Nothing
 
-getNamesFromLatestParsedFile :: Cli Names
-getNamesFromLatestParsedFile = do
-  uf <- getLatestParsedFile
-  pure $ case uf of
+-- | Gets the names from the latest typechecked unison file, or latest parsed file if it
+-- didn't typecheck.
+getNamesFromLatestFile :: Cli Names
+getNamesFromLatestFile = do
+  use #latestTypecheckedFile <&> \case
+    Just (Right tf) -> UFN.typecheckedToNames tf
+    Just (Left uf) -> UFN.toNames uf
     Nothing -> mempty
-    Just uf -> UFN.toNames uf
 
 -- | Get the latest typechecked unison file, or return early if there isn't one.
 expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann)

unison-cli/src/Unison/Cli/NamesUtils.hs

@@ -1,65 +1,15 @@
 -- | Utilities that have to do with constructing names objects.
 module Unison.Cli.NamesUtils
-  ( basicParseNames,
-    basicPrettyPrintNamesA,
-    displayNames,
-    getBasicPrettyPrintNames,
-    makePrintNamesFromLabeled',
-    makeShadowedPrintNamesFromHQ,
+  ( currentNames,
   )
 where
 
 import Unison.Cli.Monad (Cli)
-import Unison.Cli.MonadUtils qualified as Cli
-import Unison.Codebase.Path (Path)
-import Unison.Codebase.Path qualified as Path
+import Unison.Cli.MonadUtils (getCurrentBranch0)
+import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Names (Names)
-import Unison.NamesWithHistory qualified as Names
-import Unison.Server.Backend qualified as Backend
-import Unison.UnisonFile (TypecheckedUnisonFile)
-import Unison.UnisonFile.Names qualified as UF
-import Unison.Var (Var)
 
-basicParseNames :: Cli Names
-basicParseNames =
-  fst <$> basicNames' Backend.Within
-
-basicPrettyPrintNamesA :: Cli Names
-basicPrettyPrintNamesA = snd <$> basicNames' Backend.AllNames
-
--- implementation detail of basicParseNames and basicPrettyPrintNames
-basicNames' :: (Path -> Backend.NameScoping) -> Cli (Names, Names)
-basicNames' nameScoping = do
-  root' <- Cli.getRootBranch
-  currentPath' <- Cli.getCurrentPath
-  let (parse, pretty, _local) = Backend.namesForBranch root' (nameScoping $ Path.unabsolute currentPath')
-  pure (parse, pretty)
-
--- | Produce a `Names` needed to display all the hashes used in the given file.
-displayNames ::
-  (Var v) =>
-  TypecheckedUnisonFile v a ->
-  Cli Names
-displayNames unisonFile =
-  -- voodoo
-  makeShadowedPrintNamesFromLabeled
-    (UF.typecheckedToNames unisonFile)
-
-getBasicPrettyPrintNames :: Cli Names
-getBasicPrettyPrintNames = do
-  rootBranch <- Cli.getRootBranch
-  currentPath <- Cli.getCurrentPath
-  pure (Backend.prettyNamesForBranch rootBranch (Backend.AllNames (Path.unabsolute currentPath)))
-
-makePrintNamesFromLabeled' :: Cli Names
-makePrintNamesFromLabeled' =
-  basicPrettyPrintNamesA
-
-makeShadowedPrintNamesFromHQ :: Names -> Cli Names
-makeShadowedPrintNamesFromHQ shadowing = do
-  basicNames <- basicPrettyPrintNamesA
-  pure $ Names.shadowing shadowing basicNames
-
-makeShadowedPrintNamesFromLabeled :: Names -> Cli Names
-makeShadowedPrintNamesFromLabeled shadowing =
-  Names.shadowing shadowing <$> makePrintNamesFromLabeled'
+-- | Produce a 'Names' object which contains names for the current branch.
+currentNames :: Cli Names
+currentNames = do
+  Branch.toNames <$> getCurrentBranch0

unison-cli/src/Unison/Cli/PrettyPrintUtils.hs

@@ -1,33 +1,32 @@
 -- | Utilities that have to do with constructing pretty-print environments, given stateful information in the Cli monad
 -- state/environment, such as the current path.
 module Unison.Cli.PrettyPrintUtils
-  ( prettyPrintEnvDecl,
+  ( prettyPrintEnvDeclFromNames,
     currentPrettyPrintEnvDecl,
   )
 where
 
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
-import Unison.Cli.MonadUtils qualified as Cli
+import Unison.Cli.NamesUtils qualified as Cli
 import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Path (Path)
-import Unison.Codebase.Path qualified as Path
 import Unison.Names (Names)
 import Unison.Prelude
 import Unison.PrettyPrintEnv.Names qualified as PPE
-import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
+import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo)
 import Unison.PrettyPrintEnvDecl.Names qualified as PPED
-import Unison.Server.Backend qualified as Backend
 
-prettyPrintEnvDecl :: Names -> Cli PrettyPrintEnvDecl
-prettyPrintEnvDecl ns =
+-- | Builds a pretty print env decl from a names object.
+prettyPrintEnvDeclFromNames :: Names -> Cli PPE.PrettyPrintEnvDecl
+prettyPrintEnvDeclFromNames ns =
   Cli.runTransaction Codebase.hashLength <&> \hashLen ->
     PPED.makePPED (PPE.hqNamer hashLen ns) (PPE.suffixifyByHash ns)
 
 -- | Get a pretty print env decl for the current names at the current path.
-currentPrettyPrintEnvDecl :: (Path -> Backend.NameScoping) -> Cli PrettyPrintEnvDecl
-currentPrettyPrintEnvDecl scoping = do
-  root' <- Cli.getRootBranch
-  currentPath <- Cli.getCurrentPath
-  hqLen <- Cli.runTransaction Codebase.hashLength
-  pure $ Backend.getCurrentPrettyNames hqLen (scoping (Path.unabsolute currentPath)) root'
+--
+-- Prefer using 'prettyPrintEnvDeclFromNames' when you've already got
+-- a 'Names' value around, since using 'currentPrettyPrintEnvDecl' rebuilds the underlying
+-- names object.
+currentPrettyPrintEnvDecl :: Cli PPE.PrettyPrintEnvDecl
+currentPrettyPrintEnvDecl = do
+  Cli.currentNames >>= prettyPrintEnvDeclFromNames