Limit definition search to provided relativeTo

codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs

@@ -64,7 +64,8 @@ module U.Codebase.Sqlite.Operations
 
     -- ** name lookup index
     rebuildNameIndex,
-    rootBranchNames,
+    rootNamesByPath,
+    NamesByPath (..),
 
     -- * low-level stuff
     expectDbBranch,
@@ -1030,9 +1031,28 @@ rebuildNameIndex termNames typeNames = do
   Q.insertTermNames ((fmap (c2sTextReferent *** fmap c2sConstructorType) <$> termNames))
   Q.insertTypeNames ((fmap c2sTextReference <$> typeNames))
 
+data NamesByPath = NamesByPath
+  { termNamesInPath :: [S.NamedRef (C.Referent, Maybe C.ConstructorType)],
+    termNamesExternalToPath :: [S.NamedRef (C.Referent, Maybe C.ConstructorType)],
+    typeNamesInPath :: [S.NamedRef C.Reference],
+    typeNamesExternalToPath :: [S.NamedRef C.Reference]
+  }
+
 -- | Get all the term and type names for the root namespace from the lookup table.
-rootBranchNames :: Transaction ([S.NamedRef (C.Referent, Maybe C.ConstructorType)], [S.NamedRef C.Reference])
-rootBranchNames = do
-  termNames <- Q.rootTermNames
-  typeNames <- Q.rootTypeNames
-  pure (fmap (bimap s2cTextReferent (fmap s2cConstructorType)) <$> termNames, fmap s2cTextReference <$> typeNames)
+rootNamesByPath ::
+  -- | A relative namespace string, e.g. Just "base.List"
+  Maybe Text ->
+  Transaction NamesByPath
+rootNamesByPath path = do
+  (termNamesInPath, termNamesExternalToPath) <- Q.rootTermNamesByPath path
+  (typeNamesInPath, typeNamesExternalToPath) <- Q.rootTypeNamesByPath path
+  pure $
+    NamesByPath
+      { termNamesInPath = convertTerms <$> termNamesInPath,
+        termNamesExternalToPath = convertTerms <$> termNamesExternalToPath,
+        typeNamesInPath = convertTypes <$> typeNamesInPath,
+        typeNamesExternalToPath = convertTypes <$> typeNamesExternalToPath
+      }
+  where
+    convertTerms = fmap (bimap s2cTextReferent (fmap s2cConstructorType))
+    convertTypes = fmap s2cTextReference

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -127,8 +127,8 @@ module U.Codebase.Sqlite.Queries
     resetNameLookupTables,
     insertTermNames,
     insertTypeNames,
-    rootTermNames,
-    rootTypeNames,
+    rootTermNamesByPath,
+    rootTypeNamesByPath,
     getNamespaceDefinitionCount,
 
     -- * garbage collection
@@ -1521,26 +1521,38 @@ insertTypeNames names =
         |]
 
 -- | Get the list of a term names in the root namespace according to the name lookup index
-rootTermNames :: Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)]
-rootTermNames = do
-  (fmap . fmap) unRow <$> queryListRow_ sql
+rootTermNamesByPath :: Maybe Text -> Transaction ([NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)], [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)])
+rootTermNamesByPath mayNamespace = do
+  let (namespace, subnamespace) = case mayNamespace of
+        Nothing -> ("", "*")
+        Just namespace -> (namespace, globEscape namespace <> ".*")
+  results :: [Only Bool :. NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
+  let (namesInNamespace, namesOutsideNamespace) = span (\(Only inNamespace :. _) -> inNamespace) results
+  pure (fmap unRow . dropTag <$> namesInNamespace, fmap unRow . dropTag <$> namesOutsideNamespace)
   where
+    dropTag (_ :. name) = name
     unRow (a :. Only b) = (a, b)
     sql =
       [here|
-        SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type FROM term_name_lookup
-          ORDER BY reversed_name ASC
+        SELECT namespace GLOB ? OR namespace = ?, reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type FROM term_name_lookup
+        ORDER BY (namespace GLOB ? OR namespace = ?) DESC
         |]
 
 -- | Get the list of a type names in the root namespace according to the name lookup index
-rootTypeNames :: Transaction [NamedRef Reference.TextReference]
-rootTypeNames = do
-  queryListRow_ sql
+rootTypeNamesByPath :: Maybe Text -> Transaction ([NamedRef Reference.TextReference], [NamedRef Reference.TextReference])
+rootTypeNamesByPath mayNamespace = do
+  let (namespace, subnamespace) = case mayNamespace of
+        Nothing -> ("", "*")
+        Just namespace -> (namespace, globEscape namespace <> ".*")
+  results :: [Only Bool :. NamedRef Reference.TextReference] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
+  let (namesInNamespace, namesOutsideNamespace) = span (\(Only inNamespace :. _) -> inNamespace) results
+  pure (dropTag <$> namesInNamespace, dropTag <$> namesOutsideNamespace)
   where
+    dropTag (_ :. name) = name
     sql =
       [here|
-        SELECT reversed_name, reference_builtin, reference_component_hash, reference_component_index FROM type_name_lookup
-        ORDER BY reversed_name ASC
+        SELECT namespace GLOB ? OR namespace = ?, reversed_name, reference_builtin, reference_component_hash, reference_component_index FROM type_name_lookup
+        ORDER BY (namespace GLOB ? OR namespace = ?) DESC
         |]
 
 before :: CausalHashId -> CausalHashId -> Transaction Bool

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

@@ -25,6 +25,7 @@ import qualified U.Codebase.Referent as C.Referent
 import U.Codebase.Sqlite.DbId (ObjectId)
 import qualified U.Codebase.Sqlite.NamedRef as S
 import qualified U.Codebase.Sqlite.ObjectType as OT
+import U.Codebase.Sqlite.Operations (NamesByPath (..))
 import qualified U.Codebase.Sqlite.Operations as Ops
 import qualified U.Codebase.Sqlite.Queries as Q
 import U.Codebase.Sqlite.V2.Decl (saveDeclComponent)
@@ -552,48 +553,52 @@ namesAtPath ::
   Path ->
   Transaction ScopedNames
 namesAtPath path = do
-  (termNames, typeNames) <- Ops.rootBranchNames
+  let namespace = if path == Path.empty then Nothing else Just $ tShow path
+  NamesByPath {termNamesInPath, termNamesExternalToPath, typeNamesInPath, typeNamesExternalToPath} <- Ops.rootNamesByPath namespace
+  let termsInPath = convertTerms termNamesInPath
+  let typesInPath = convertTypes typeNamesInPath
+  let termsOutsidePath = convertTerms termNamesExternalToPath
+  let typesOutsidePath = convertTypes typeNamesExternalToPath
   let allTerms :: [(Name, Referent.Referent)]
-      allTerms =
-        termNames <&> \(S.NamedRef {reversedSegments, ref = (ref, ct)}) ->
-          let v1ref = runIdentity $ Cv.referent2to1 (const . pure . Cv.constructorType2to1 . fromMaybe (error "Required constructor type for constructor but it was null") $ ct) ref
-           in (Name.fromReverseSegments (coerce reversedSegments), v1ref)
+      allTerms = termsInPath <> termsOutsidePath
   let allTypes :: [(Name, Reference.Reference)]
-      allTypes =
-        typeNames <&> \(S.NamedRef {reversedSegments, ref}) ->
-          (Name.fromReverseSegments (coerce reversedSegments), Cv.reference2to1 ref)
+      allTypes = typesInPath <> typesOutsidePath
   let rootTerms = Rel.fromList allTerms
   let rootTypes = Rel.fromList allTypes
   let absoluteRootNames = Names {terms = rootTerms, types = rootTypes}
-  let (relativeScopedNames, absoluteExternalNames) =
+  let absoluteExternalNames = Names {terms = Rel.fromList termsOutsidePath, types = Rel.fromList typesOutsidePath}
+  let relativeScopedNames =
         case path of
-          Path.Empty -> (absoluteRootNames, mempty)
+          Path.Empty -> (absoluteRootNames)
           p ->
             let reversedPathSegments = reverse . Path.toList $ p
-                (relativeTerms, externalTerms) = foldMap (partitionByPathPrefix reversedPathSegments) allTerms
-                (relativeTypes, externalTypes) = foldMap (partitionByPathPrefix reversedPathSegments) allTypes
-             in ( Names {terms = Rel.fromList relativeTerms, types = Rel.fromList relativeTypes},
-                  Names {terms = Rel.fromList externalTerms, types = Rel.fromList externalTypes}
-                )
+                relativeTerms = stripPathPrefix reversedPathSegments <$> termsInPath
+                relativeTypes = stripPathPrefix reversedPathSegments <$> typesInPath
+             in (Names {terms = Rel.fromList relativeTerms, types = Rel.fromList relativeTypes})
   pure $
     ScopedNames
       { absoluteExternalNames,
         relativeScopedNames,
         absoluteRootNames
       }
   where
+    convertTypes names =
+      names <&> \(S.NamedRef {reversedSegments, ref}) ->
+        (Name.fromReverseSegments (coerce reversedSegments), Cv.reference2to1 ref)
+    convertTerms names =
+      names <&> \(S.NamedRef {reversedSegments, ref = (ref, ct)}) ->
+        let v1ref = runIdentity $ Cv.referent2to1 (const . pure . Cv.constructorType2to1 . fromMaybe (error "Required constructor type for constructor but it was null") $ ct) ref
+         in (Name.fromReverseSegments (coerce reversedSegments), v1ref)
+
     -- If the given prefix matches the given name, the prefix is stripped and it's collected
     -- on the left, otherwise it's left as-is and collected on the right.
-    -- >>> partitionByPathPrefix ["b", "a"] ("a.b.c", ())
-    -- ([(c,())],[])
-    --
-    -- >>> partitionByPathPrefix ["y", "x"] ("a.b.c", ())
-    -- ([],[(a.b.c,())])
-    partitionByPathPrefix :: [NameSegment] -> (Name, r) -> ([(Name, r)], [(Name, r)])
-    partitionByPathPrefix reversedPathSegments (n, ref) =
+    -- >>> stripPathPrefix ["b", "a"] ("a.b.c", ())
+    -- ([(c,())])
+    stripPathPrefix :: [NameSegment] -> (Name, r) -> (Name, r)
+    stripPathPrefix reversedPathSegments (n, ref) =
       case Name.stripReversedPrefix n reversedPathSegments of
-        Nothing -> (mempty, [(n, ref)])
-        Just stripped -> ([(Name.makeRelative stripped, ref)], mempty)
+        Nothing -> error $ "Expected name to be in namespace" <> show (n, reverse reversedPathSegments)
+        Just stripped -> (Name.makeRelative stripped, ref)
 
 -- | Update the root namespace names index which is used by the share server for serving api
 -- requests.

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -3376,7 +3376,8 @@ basicNames' :: (Functor m) => (Path -> Backend.NameScoping) -> Action m i v (Nam
 basicNames' nameScoping = do
   root' <- use LoopState.root
   currentPath' <- use LoopState.currentPath
-  pure $ Backend.prettyAndParseNamesForBranch root' (nameScoping $ Path.unabsolute currentPath')
+  let (parse, pretty, _local) = Backend.namesForBranch root' (nameScoping $ Path.unabsolute currentPath')
+  pure (parse, pretty)
 
 data AddRunMainResult v
   = NoTermWithThatName
@@ -3496,7 +3497,7 @@ diffHelperCmd ::
 diffHelperCmd currentRoot currentPath before after = do
   hqLength <- eval CodebaseHashLength
   diff <- eval . Eval $ BranchDiff.diff0 before after
-  let (_parseNames, prettyNames0) = Backend.prettyAndParseNamesForBranch currentRoot (Backend.AllNames $ Path.unabsolute currentPath)
+  let (_parseNames, prettyNames0, _local) = Backend.namesForBranch currentRoot (Backend.AllNames $ Path.unabsolute currentPath)
   ppe <- PPE.suffixifiedPPE <$> prettyPrintEnvDecl (NamesWithHistory prettyNames0 mempty)
   (ppe,)
     <$> OBranchDiff.toOutput

unison-core/src/Unison/NamesWithHistory.hs

@@ -2,7 +2,7 @@
 
 module Unison.NamesWithHistory where
 
-import Control.Lens (view, _4)
+import Control.Lens (view, _5)
 import Data.List.Extra (nubOrd, sort)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -264,17 +264,18 @@ suffixedTermName :: Int -> Referent -> NamesWithHistory -> [HQ'.HashQualified Na
       where
         -- Orders names, using these criteria, in this order:
         -- 1. NameOnly comes before HashQualified,
-        -- 2. Shorter names (in terms of segment count) come before longer ones
-        -- 3. If same on attributes 1 and 2, compare alphabetically
+        -- 2. Names with shorter fully-qualified names (in terms of segment count) come before longer ones
+        -- 3. Shorter _suffixified_ names (in terms of segment count) come before longer ones
+        -- 4. If same on all other attributes, compare alphabetically
         go :: [Name] -> [HQ'.HashQualified Name]
-        go fqns = map (view _4) . sort $ map f fqns
+        go fqns = map (view _5) . sort $ map f fqns
           where
             f fqn =
               let n' = Name.shortestUniqueSuffix fqn r rel
                   isHQ'd = R.manyDom fqn rel -- it is conflicted
                   hq n = HQ'.take length (hq' n r)
                   hqn = if isHQ'd then hq n' else HQ'.fromName n'
-               in (isHQ'd, Name.countSegments fqn, Name.isAbsolute n', hqn)
+               in (isHQ'd, Name.countSegments fqn, Name.countSegments n', Name.isAbsolute n', hqn)
 
 -- Set HashQualified -> Branch m -> Action' m v Names
 -- Set HashQualified -> Branch m -> Free (Command m i v) Names