Propagate search type to Backend.

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

@@ -238,7 +238,7 @@ loop e = do
           doRemoveReplacement from patchPath isTerm = do
             let patchPath' = fromMaybe Cli.defaultPatchPath patchPath
             patch <- Cli.getPatchAt patchPath'
-            QueryResult misses allHits <- hqNameQuery [from]
+            QueryResult misses allHits <- hqNameQuery NamesWithHistory.IncludeSuffixes [from]
             let tpRefs = Set.fromList $ typeReferences allHits
                 tmRefs = Set.fromList $ termReferences allHits
                 (hits, opHits) =
@@ -936,8 +936,8 @@ loop e = do
 
               let patchPath' = fromMaybe Cli.defaultPatchPath patchPath
               patch <- Cli.getPatchAt patchPath'
-              QueryResult fromMisses' fromHits <- hqNameQuery [from]
-              QueryResult toMisses' toHits <- hqNameQuery [to]
+              QueryResult fromMisses' fromHits <- hqNameQuery NamesWithHistory.IncludeSuffixes [from]
+              QueryResult toMisses' toHits <- hqNameQuery NamesWithHistory.IncludeSuffixes [to] 
               let termsFromRefs = termReferences fromHits
                   termsToRefs = termReferences toHits
                   typesFromRefs = typeReferences fromHits
@@ -2024,7 +2024,7 @@ handleShowDefinition outputLoc showDefinitionScope inputQuery = do
       pure (currentNames, ppe)
   Backend.DefinitionResults terms types misses <- do
     let nameSearch = NameSearch.makeNameSearch hqLength names
-    Cli.runTransaction (Backend.definitionsBySuffixes codebase nameSearch includeCycles query)
+    Cli.runTransaction (Backend.definitionsByName codebase nameSearch includeCycles NamesWithHistory.IncludeSuffixes query)
   outputPath <- getOutputPath
   when (not (null types && null terms)) do
     -- We need an 'isTest' check in the output layer, so it can prepend "test>" to tests in a scratch file. Since we
@@ -3057,16 +3057,16 @@ loadTypeOfTerm _ Referent.Con {} =
   error $
     reportBug "924628772" "Attempt to load a type declaration which is a builtin!"
 
-hqNameQuery :: [HQ.HashQualified Name] -> Cli QueryResult
-hqNameQuery query = do
+hqNameQuery :: NamesWithHistory.SearchType -> [HQ.HashQualified Name] -> Cli QueryResult
+hqNameQuery searchType query = do
   Cli.Env {codebase} <- ask
   root' <- Cli.getRootBranch
   currentPath <- Cli.getCurrentPath
   Cli.runTransaction do
     hqLength <- Codebase.hashLength
     let parseNames = Backend.parseNamesForBranch root' (Backend.AllNames (Path.unabsolute currentPath))
     let nameSearch = NameSearch.makeNameSearch hqLength (NamesWithHistory.fromCurrentNames parseNames)
-    Backend.hqNameQuery codebase nameSearch query
+    Backend.hqNameQuery codebase nameSearch searchType query
 
 -- | Select a definition from the given branch.
 -- Returned names will match the provided 'Position' type.

unison-share-api/src/Unison/Server/Backend.hs

@@ -27,7 +27,7 @@ module Unison.Server.Backend
     basicSuffixifiedNames,
     bestNameForTerm,
     bestNameForType,
-    definitionsBySuffixes,
+    definitionsByName,
     displayType,
     docsInBranchToHtmlFiles,
     expandShortCausalHash,
@@ -756,9 +756,10 @@ fixupNamesRelative root names =
 hqNameQuery ::
   Codebase m v Ann ->
   NameSearch Sqlite.Transaction ->
+  NamesWithHistory.SearchType ->
   [HQ.HashQualified Name] ->
   Sqlite.Transaction QueryResult
-hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
+hqNameQuery codebase NameSearch {typeSearch, termSearch} searchType hqs = do
   -- Split the query into hash-only and hash-qualified-name queries.
   let (hashes, hqnames) = partitionEithers (map HQ'.fromHQ2 hqs)
   -- Find the terms with those hashes.
@@ -783,7 +784,7 @@ hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
         (\(sh, tps) -> mkTypeResult sh <$> toList tps) <$> typeRefs
 
   -- Now do the actual name query
-  resultss <- for hqnames (\name -> liftA2 (<>) (applySearch typeSearch name) (applySearch termSearch name))
+  resultss <- for hqnames (\name -> liftA2 (<>) (applySearch typeSearch searchType name) (applySearch termSearch searchType name))
   let (misses, hits) =
         zipWith
           ( \hqname results ->
@@ -1002,8 +1003,7 @@ docsForDefinitionName codebase (NameSearch {termSearch}) name = do
   Codebase.runTransaction codebase do
     refs <-
       potentialDocNames & foldMapM \name ->
-        -- TODO: Should replace this with an exact name lookup.
-        lookupRelativeHQRefs' termSearch (HQ'.NameOnly name)
+        lookupRelativeHQRefs' termSearch NamesWithHistory.ExactName (HQ'.NameOnly name)
     filterForDocs (toList refs)
   where
     filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
@@ -1229,14 +1229,15 @@ data IncludeCycles
   = IncludeCycles
   | DontIncludeCycles
 
-definitionsBySuffixes ::
+definitionsByName ::
   Codebase m Symbol Ann ->
   NameSearch Sqlite.Transaction ->
   IncludeCycles ->
+  NamesWithHistory.SearchType ->
   [HQ.HashQualified Name] ->
   Sqlite.Transaction DefinitionResults
-definitionsBySuffixes codebase nameSearch includeCycles query = do
-  QueryResult misses results <- hqNameQuery codebase nameSearch query
+definitionsByName codebase nameSearch includeCycles searchType query = do
+  QueryResult misses results <- hqNameQuery codebase nameSearch searchType query
   -- todo: remember to replace this with getting components directly,
   -- and maybe even remove getComponentLength from Codebase interface altogether
   terms <- Map.foldMapM (\ref -> (ref,) <$> displayTerm codebase ref) (searchResultsToTermRefs results)

unison-share-api/src/Unison/Server/Local/Definitions.hs

@@ -66,7 +66,7 @@ prettyDefinitionsForHQName perspective shallowRoot renderWidth suffixifyBindings
   let pped = PPED.biasTo biases unbiasedPPED
   let nameSearch = makeNameSearch hqLength (NamesWithHistory.fromCurrentNames localNamesOnly)
   (DefinitionResults terms types misses) <- liftIO $ Codebase.runTransaction codebase do
-    definitionsBySuffixes codebase nameSearch DontIncludeCycles [query]
+    definitionsByName codebase nameSearch DontIncludeCycles NamesWithHistory.ExactName [query]
   let width = mayDefaultWidth renderWidth
   let docResults :: Name -> IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
       docResults name = do

unison-share-api/src/Unison/Server/NameSearch.hs

@@ -6,6 +6,7 @@ import Data.Set qualified as Set
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
+import Unison.NamesWithHistory (SearchType)
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Referent (Referent)
@@ -21,7 +22,7 @@ import Unison.Server.SearchResult qualified as SR
 -- You can use the individual methods of a name search or can use 'applySearch'.
 data Search m r = Search
   { lookupNames :: r -> m (Set (HQ'.HashQualified Name)),
-    lookupRelativeHQRefs' :: HQ'.HashQualified Name -> m (Set r),
+    lookupRelativeHQRefs' :: SearchType -> HQ'.HashQualified Name -> m (Set r),
     makeResult :: HQ.HashQualified Name -> r -> Set (HQ'.HashQualified Name) -> m SR.SearchResult,
     matchesNamedRef :: Name -> r -> HQ'.HashQualified Name -> Bool
   }
@@ -32,9 +33,9 @@ data NameSearch m = NameSearch
   }
 
 -- | Interpret a 'Search' as a function from name to search results.
-applySearch :: (Show r, Monad m) => Search m r -> HQ'.HashQualified Name -> m [SR.SearchResult]
-applySearch Search {lookupNames, lookupRelativeHQRefs', makeResult, matchesNamedRef} query = do
-  refs <- (lookupRelativeHQRefs' query)
+applySearch :: (Show r, Monad m) => Search m r -> SearchType -> HQ'.HashQualified Name -> m [SR.SearchResult]
+applySearch Search {lookupNames, lookupRelativeHQRefs', makeResult, matchesNamedRef} searchType query = do
+  refs <- (lookupRelativeHQRefs' searchType query)
   -- a bunch of references will match a HQ ref.
   for (toList refs) \ref -> do
     let -- Precondition: the input set is non-empty

unison-share-api/src/Unison/Server/NameSearch/FromNames.hs

@@ -13,7 +13,7 @@ makeTypeSearch :: (Applicative m) => Int -> NamesWithHistory -> Search m Referen
 makeTypeSearch len names =
   Search
     { lookupNames = \ref -> pure $ NamesWithHistory.typeName len ref names,
-      lookupRelativeHQRefs' = \n -> pure $ NamesWithHistory.lookupRelativeHQType' NamesWithHistory.ExactName n names,
+      lookupRelativeHQRefs' = \searchType n -> pure $ NamesWithHistory.lookupRelativeHQType' searchType n names,
       matchesNamedRef = HQ'.matchesNamedReference,
       makeResult = \hqname r names -> pure $ SR.typeResult hqname r names
     }
@@ -23,7 +23,7 @@ makeTermSearch :: (Applicative m) => Int -> NamesWithHistory -> Search m Referen
 makeTermSearch len names =
   Search
     { lookupNames = \ref -> pure $ NamesWithHistory.termName len ref names,
-      lookupRelativeHQRefs' = \n -> pure $ NamesWithHistory.lookupRelativeHQTerm' NamesWithHistory.ExactName n names,
+      lookupRelativeHQRefs' = \searchType n -> pure $ NamesWithHistory.lookupRelativeHQTerm' searchType n names,
       matchesNamedRef = HQ'.matchesNamedReferent,
       makeResult = \hqname r names -> pure $ SR.termResult hqname r names
     }

unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs

@@ -22,6 +22,7 @@ import Unison.LabeledDependency qualified as LD
 import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment (..))
+import Unison.NamesWithHistory (SearchType (ExactName, IncludeSuffixes))
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
@@ -33,11 +34,6 @@ import Unison.ShortHash qualified as SH
 import Unison.Sqlite qualified as Sqlite
 import Unison.Util.Set qualified as Set
 
-data SearchStrategy
-  = ExactMatch
-  | SuffixMatch
-  deriving (Show, Eq)
-
 nameSearchForPerspective :: Codebase m v a -> Ops.NamesPerspective -> (NameSearch Sqlite.Transaction)
 nameSearchForPerspective codebase namesPerspective@Ops.NamesPerspective {pathToMountedNameLookup} = do
   NameSearch {typeSearch, termSearch}
@@ -49,14 +45,14 @@ nameSearchForPerspective codebase [email protected] {pathToM
     typeSearch =
       Search
         { lookupNames = lookupNamesForTypes,
-          lookupRelativeHQRefs' = lookupRelativeHQRefsForTypes . fmap stripMountPathPrefix,
+          lookupRelativeHQRefs' = \searchType n -> hqTypeSearch searchType . fmap stripMountPathPrefix $ n,
           makeResult = \hqname r names -> pure $ SR.typeResult hqname r names,
           matchesNamedRef = HQ'.matchesNamedReference
         }
     termSearch =
       Search
         { lookupNames = lookupNamesForTerms,
-          lookupRelativeHQRefs' = lookupRelativeHQRefsForTerms . fmap stripMountPathPrefix,
+          lookupRelativeHQRefs' = \searchType n -> hqTermSearch searchType . fmap stripMountPathPrefix $ n,
           makeResult = \hqname r names -> pure $ SR.termResult hqname r names,
           matchesNamedRef = HQ'.matchesNamedReferent
         }
@@ -75,37 +71,16 @@ nameSearchForPerspective codebase [email protected] {pathToM
         & fmap (\segments -> HQ'.HashQualified (reversedSegmentsToName segments) (Referent.toShortHash ref))
         & Set.fromList
         & pure
-    -- This is a bit messy, but the existing 'lookupRelativeHQRefs' semantics
-    -- will return ONLY exact matches if any exist, otherwise it falls back on
-    -- suffix search, so we maintain that behaviour here. It would probably be better
-    -- to have separate functions in the Search type for each of these, and be more explicit
-    -- about desired behaviour at the call-site.
-    lookupRelativeHQRefsForTerms :: HQ'.HashQualified Name -> Sqlite.Transaction (Set Referent)
-    lookupRelativeHQRefsForTerms hqName = do
-      exact <- hqTermSearch ExactMatch hqName
-      if Set.null exact
-        then do
-          hqTermSearch SuffixMatch hqName
-        else do
-          pure exact
-    lookupRelativeHQRefsForTypes :: HQ'.HashQualified Name -> Sqlite.Transaction (Set Reference)
-    lookupRelativeHQRefsForTypes hqName = do
-      exact <- hqTypeSearch ExactMatch hqName
-      if Set.null exact
-        then do
-          hqTypeSearch SuffixMatch hqName
-        else do
-          pure exact
     -- Search the codebase for matches to the given hq name.
     -- Supports either an exact match or a suffix match.
-    hqTermSearch :: SearchStrategy -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Referent)
+    hqTermSearch :: SearchType -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Referent)
     hqTermSearch searchStrat hqName = do
       case hqName of
         HQ'.NameOnly name -> do
           namedRefs <-
             case searchStrat of
-              ExactMatch -> Ops.termRefsForExactName namesPerspective (coerce $ Name.reverseSegments name)
-              SuffixMatch -> Ops.termNamesBySuffix namesPerspective (coerce $ Name.reverseSegments name)
+              ExactName -> Ops.termRefsForExactName namesPerspective (coerce $ Name.reverseSegments name)
+              IncludeSuffixes -> Ops.termNamesBySuffix namesPerspective (coerce $ Name.reverseSegments name)
           namedRefs
             & fmap
               ( \(NamedRef.ref -> (ref, mayCT)) ->
@@ -120,21 +95,21 @@ nameSearchForPerspective codebase [email protected] {pathToM
             matches <- Ops.termNamesForRefWithinNamespace namesPerspective (Cv.referent1to2 termRef) (Just . coerce $ Name.reverseSegments name)
             -- Return a valid ref if at least one match was found. Require that it be an exact
             -- match if specified.
-            if any (\n -> coerce (Name.reverseSegments fqn) == n || searchStrat /= ExactMatch) matches
+            if any (\n -> coerce (Name.reverseSegments fqn) == n || searchStrat /= ExactName) matches
               then pure (Just termRef)
               else pure Nothing
 
     -- Search the codebase for matches to the given hq name.
     -- Supports either an exact match or a suffix match.
-    hqTypeSearch :: SearchStrategy -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Reference)
+    hqTypeSearch :: SearchType -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Reference)
     hqTypeSearch searchStrat hqName = do
       case hqName of
         HQ'.NameOnly name -> do
           let fqn = fullyQualifyName name
           namedRefs <-
             case searchStrat of
-              ExactMatch -> Ops.typeRefsForExactName namesPerspective (coerce $ Name.reverseSegments fqn)
-              SuffixMatch -> Ops.typeNamesBySuffix namesPerspective (coerce $ Name.reverseSegments name)
+              ExactName -> Ops.typeRefsForExactName namesPerspective (coerce $ Name.reverseSegments fqn)
+              IncludeSuffixes -> Ops.typeNamesBySuffix namesPerspective (coerce $ Name.reverseSegments name)
           namedRefs
             & fmap (Cv.reference2to1 . NamedRef.ref)
             & Set.fromList
@@ -146,7 +121,7 @@ nameSearchForPerspective codebase [email protected] {pathToM
             matches <- Ops.typeNamesForRefWithinNamespace namesPerspective (Cv.reference1to2 typeRef) (Just . coerce $ Name.reverseSegments name)
             -- Return a valid ref if at least one match was found. Require that it be an exact
             -- match if specified.
-            if any (\n -> coerce (Name.reverseSegments fqn) == n || searchStrat /= ExactMatch) matches
+            if any (\n -> coerce (Name.reverseSegments fqn) == n || searchStrat /= ExactName) matches
               then pure (Just typeRef)
               else pure Nothing