diff --git a/parser-typechecker/src/Unison/Codebase/MainTerm.hs b/parser-typechecker/src/Unison/Codebase/MainTerm.hs index c566470146..13ac680417 100644 --- a/parser-typechecker/src/Unison/Codebase/MainTerm.hs +++ b/parser-typechecker/src/Unison/Codebase/MainTerm.hs @@ -39,7 +39,7 @@ getMainTerm loadTypeOfTerm parseNames mainName mainType = case HQ.fromString mainName of Nothing -> pure (NotAFunctionName mainName) Just hq -> do - let refs = NamesWithHistory.lookupHQTerm hq (NamesWithHistory.NamesWithHistory parseNames mempty) + let refs = NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes hq (NamesWithHistory.NamesWithHistory parseNames mempty) let a = Parser.Ann.External case toList refs of [] -> pure (NotFound mainName) diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 0784dba5cd..90d6eeb407 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -111,7 +111,7 @@ typeLink' :: (Monad m, Var v) => P v m (L.Token Reference) typeLink' = do id <- hqPrefixId ns <- asks names - case NamesWithHistory.lookupHQType (L.payload id) ns of + case NamesWithHistory.lookupHQType NamesWithHistory.IncludeSuffixes (L.payload id) ns of s | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id | otherwise -> customFailure $ UnknownType id s @@ -120,7 +120,7 @@ termLink' :: (Monad m, Var v) => P v m (L.Token Referent) termLink' = do id <- hqPrefixId ns <- asks names - case NamesWithHistory.lookupHQTerm (L.payload id) ns of + case NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes (L.payload id) ns of s | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id | otherwise -> customFailure $ UnknownTerm id s @@ -129,7 +129,7 @@ link' :: (Monad m, Var v) => P v m (Either (L.Token Reference) (L.Token Referent link' = do id <- hqPrefixId ns <- asks names - case (NamesWithHistory.lookupHQTerm (L.payload id) ns, NamesWithHistory.lookupHQType (L.payload id) ns) of + case (NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes (L.payload id) ns, NamesWithHistory.lookupHQType NamesWithHistory.IncludeSuffixes (L.payload id) ns) of (s, s2) | Set.size s == 1 && Set.null s2 -> pure . Right $ const (Set.findMin s) <$> id (s, s2) | Set.size s2 == 1 && Set.null s -> pure . Left $ const (Set.findMin s2) <$> id (s, s2) -> customFailure $ UnknownId id s s2 @@ -279,7 +279,7 @@ parsePattern = label "pattern" root names <- asks names -- probably should avoid looking up in `names` if `L.payload tok` -- starts with a lowercase - case NamesWithHistory.lookupHQPattern (L.payload tok) ct names of + case NamesWithHistory.lookupHQPattern NamesWithHistory.IncludeSuffixes (L.payload tok) ct names of s | Set.null s -> die tok s | Set.size s > 1 -> die tok s @@ -420,7 +420,7 @@ resolveHashQualified tok = do names <- asks names case L.payload tok of HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n) - _ -> case NamesWithHistory.lookupHQTerm (L.payload tok) names of + _ -> case NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes (L.payload tok) names of s | Set.null s -> failCommitted $ UnknownTerm tok s | Set.size s > 1 -> failCommitted $ UnknownTerm tok s @@ -1151,7 +1151,7 @@ substImports ns imports = -- not in Names, but in a later term binding [ (suffix, Type.var () full) | (suffix, full) <- imports, - NamesWithHistory.hasTypeNamed (Name.unsafeFromVar full) ns + NamesWithHistory.hasTypeNamed NamesWithHistory.IncludeSuffixes (Name.unsafeFromVar full) ns ] block' :: (Monad m, Var v) => IsTop -> String -> P v m (L.Token ()) -> P v m (L.Token ()) -> TermP v m diff --git a/parser-typechecker/src/Unison/Syntax/TypeParser.hs b/parser-typechecker/src/Unison/Syntax/TypeParser.hs index c5f61b123a..5fc1525382 100644 --- a/parser-typechecker/src/Unison/Syntax/TypeParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TypeParser.hs @@ -41,7 +41,7 @@ typeAtom = HQ.NameOnly n -> pure $ Type.var (ann tok) (Name.toVar n) hq -> do names <- asks names - let matches = Names.lookupHQType hq names + let matches = Names.lookupHQType Names.IncludeSuffixes hq names if Set.size matches /= 1 then P.customFailure (UnknownType tok matches) else pure $ Type.ref (ann tok) (Set.findMin matches) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 75d7f25cf4..990a39245a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/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) = @@ -560,7 +560,7 @@ loop e = do let nameSearch = NameSearch.makeNameSearch hqLength (NamesWithHistory.fromCurrentNames basicPrettyPrintNames) Cli.Env {codebase, runtime} <- ask mdText <- liftIO $ do - docRefs <- Backend.docsForDefinitionName codebase nameSearch docName + docRefs <- Backend.docsForDefinitionName codebase nameSearch NamesWithHistory.IncludeSuffixes docName for docRefs $ \docRef -> do Identity (_, _, doc, _evalErrs) <- Backend.renderDocRefs pped (Pretty.Width 80) codebase runtime (Identity docRef) pure . Md.toText $ Md.toMarkdown doc @@ -715,8 +715,8 @@ loop e = do pure (currentNames, pped) let unsuffixifiedPPE = PPED.unsuffixifiedPPE pped - terms = NamesWithHistory.lookupHQTerm query names - types = NamesWithHistory.lookupHQType query names + terms = NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes query names + types = NamesWithHistory.lookupHQType NamesWithHistory.IncludeSuffixes query names terms' :: [(Referent, [HQ'.HashQualified Name])] terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms) types' :: [(Reference, [HQ'.HashQualified Name])] @@ -937,8 +937,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 @@ -1664,7 +1664,7 @@ lookupRewrite onErr prepare rule = do ot <- case ot of Just _ -> pure ot Nothing -> do - case NamesWithHistory.lookupHQTerm rule currentNames of + case NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes rule currentNames of s | Set.size s == 1, Referent.Ref (Reference.DerivedId r) <- Set.findMin s -> @@ -1961,7 +1961,7 @@ handleIOTest main = do -- Then, if we get here (because nothing in the scratch file matched), look at the terms in the codebase. Cli.runTransaction do - forMaybe (Set.toList (NamesWithHistory.lookupHQTerm main parseNames)) \ref0 -> + forMaybe (Set.toList (NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes main parseNames)) \ref0 -> runMaybeT do ref <- MaybeT (pure (Referent.toTermReferenceId ref0)) typ <- MaybeT (loadTypeOfTerm codebase (Referent.fromTermReferenceId ref)) @@ -2025,7 +2025,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 @@ -2764,7 +2764,7 @@ displayI prettyPrintNames outputLoc hq = do case addWatch (HQ.toString hq) latestTypecheckedFile of Nothing -> do let parseNames = (`NamesWithHistory.NamesWithHistory` mempty) prettyPrintNames - results = NamesWithHistory.lookupHQTerm hq parseNames + results = NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes hq parseNames pped <- prettyPrintEnvDecl parseNames ref <- Set.asSingleton results & onNothing do @@ -2805,7 +2805,7 @@ docsI srcLoc prettyPrintNames src = fileByName = do ns <- maybe mempty UF.typecheckedToNames <$> Cli.getLatestTypecheckedFile fnames <- pure $ NamesWithHistory.NamesWithHistory ns mempty - case NamesWithHistory.lookupHQTerm dotDoc fnames of + case NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes dotDoc fnames of s | Set.size s == 1 -> do -- the displayI command expects full term names, so we resolve -- the hash back to its full name in the file @@ -2831,7 +2831,7 @@ docsI srcLoc prettyPrintNames src = codebaseByName :: Cli () codebaseByName = do parseNames <- basicParseNames - case NamesWithHistory.lookupHQTerm dotDoc (NamesWithHistory.NamesWithHistory parseNames mempty) of + case NamesWithHistory.lookupHQTerm NamesWithHistory.IncludeSuffixes dotDoc (NamesWithHistory.NamesWithHistory parseNames mempty) of s | Set.size s == 1 -> displayI prettyPrintNames ConsoleLocation dotDoc | Set.size s == 0 -> Cli.respond $ ListOfLinks PPE.empty [] @@ -3058,8 +3058,8 @@ 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 @@ -3067,7 +3067,7 @@ hqNameQuery query = 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. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs index e803051e82..16a8cadffd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs @@ -25,6 +25,7 @@ import Unison.Name (Name) import Unison.Names (Names) import Unison.NamesWithHistory ( NamesWithHistory (..), + SearchType (..), lookupHQTerm, ) import Unison.Parser.Ann (Ann) @@ -41,7 +42,7 @@ addHistory :: Names -> NamesWithHistory addHistory names = NamesWithHistory names mempty lookupTerm :: HQ.HashQualified Name -> Names -> [Referent] -lookupTerm hq parseNames = toList (lookupHQTerm hq hnames) +lookupTerm hq parseNames = toList (lookupHQTerm IncludeSuffixes hq hnames) where hnames = addHistory parseNames diff --git a/unison-cli/src/Unison/LSP/Queries.hs b/unison-cli/src/Unison/LSP/Queries.hs index 6f1b29c8f7..82b1a4a7e5 100644 --- a/unison-cli/src/Unison/LSP/Queries.hs +++ b/unison-cli/src/Unison/LSP/Queries.hs @@ -37,6 +37,7 @@ import Unison.LabeledDependency import Unison.LabeledDependency qualified as LD import Unison.Lexer.Pos (Pos (..)) import Unison.Name (Name) +import Unison.NamesWithHistory (SearchType (..)) import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Pattern qualified as Pattern @@ -386,7 +387,7 @@ markdownDocsForFQN fileUri fqn = nameSearch <- lift $ getNameSearch Env {codebase, runtime} <- ask liftIO $ do - docRefs <- Backend.docsForDefinitionName codebase nameSearch name + docRefs <- Backend.docsForDefinitionName codebase nameSearch ExactName name for docRefs $ \docRef -> do Identity (_, _, doc, _evalErrs) <- Backend.renderDocRefs pped (Pretty.Width 80) codebase runtime (Identity docRef) pure . Md.toText $ Md.toMarkdown doc diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 28c03a09dd..03fb125668 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -1,6 +1,32 @@ {-# LANGUAGE RecordWildCards #-} -module Unison.NamesWithHistory where +module Unison.NamesWithHistory + ( NamesWithHistory (..), + fromCurrentNames, + filterTypes, + diff, + push, + shadowing, + lookupHQType, + lookupHQType', + lookupHQTerm, + lookupHQTerm', + lookupRelativeHQType, + lookupRelativeHQType', + lookupRelativeHQTerm, + lookupRelativeHQTerm', + hasTermNamed, + hasTypeNamed, + typeName, + termNamesByLength, + longestTermName, + termName, + importing, + lookupHQPattern, + Diff (..), + SearchType (..), + ) +where import Data.List.Extra (nubOrd) import Data.Map qualified as Map @@ -21,6 +47,13 @@ import Unison.ShortHash (ShortHash) import Unison.Util.List qualified as List import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as R +import Unison.Util.Relation qualified as Relation + +-- | Whether to search for exact matches or to find definitions by a suffix of their name. +data SearchType + = IncludeSuffixes + | ExactName + deriving (Eq, Ord, Show) -- | NamesWithHistory contains two sets of 'Names', -- One represents names which are currently assigned, @@ -120,63 +153,63 @@ shadowing prio (NamesWithHistory current old) = -- Find all types whose name has a suffix matching the provided `HashQualified`, -- returning types with relative names if they exist, and otherwise -- returning types with absolute names. -lookupRelativeHQType :: HashQualified Name -> NamesWithHistory -> Set Reference -lookupRelativeHQType hq ns@NamesWithHistory {..} = - let rs = lookupHQType hq ns +lookupRelativeHQType :: SearchType -> HashQualified Name -> NamesWithHistory -> Set Reference +lookupRelativeHQType searchType hq ns@NamesWithHistory {..} = + let rs = lookupHQType searchType hq ns keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types currentNames)) in case Set.filter keep rs of rs' | Set.null rs' -> rs | otherwise -> rs' -lookupRelativeHQType' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Reference -lookupRelativeHQType' = - lookupRelativeHQType . HQ'.toHQ +lookupRelativeHQType' :: SearchType -> HQ'.HashQualified Name -> NamesWithHistory -> Set Reference +lookupRelativeHQType' searchType = + lookupRelativeHQType searchType . HQ'.toHQ -- | Find all types whose name has a suffix matching the provided 'HashQualified'. -lookupHQType :: HashQualified Name -> NamesWithHistory -> Set Reference -lookupHQType = - lookupHQRef Names.types Reference.isPrefixOf +lookupHQType :: SearchType -> HashQualified Name -> NamesWithHistory -> Set Reference +lookupHQType searchType = + lookupHQRef searchType Names.types Reference.isPrefixOf -- | Find all types whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQType'. -lookupHQType' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Reference -lookupHQType' = - lookupHQType . HQ'.toHQ +lookupHQType' :: SearchType -> HQ'.HashQualified Name -> NamesWithHistory -> Set Reference +lookupHQType' searchType = + lookupHQType searchType . HQ'.toHQ -hasTermNamed :: Name -> NamesWithHistory -> Bool -hasTermNamed n ns = not (Set.null $ lookupHQTerm (HQ.NameOnly n) ns) +hasTermNamed :: SearchType -> Name -> NamesWithHistory -> Bool +hasTermNamed searchType n ns = not (Set.null $ lookupHQTerm searchType (HQ.NameOnly n) ns) -hasTypeNamed :: Name -> NamesWithHistory -> Bool -hasTypeNamed n ns = not (Set.null $ lookupHQType (HQ.NameOnly n) ns) +hasTypeNamed :: SearchType -> Name -> NamesWithHistory -> Bool +hasTypeNamed searchType n ns = not (Set.null $ lookupHQType searchType (HQ.NameOnly n) ns) -- Find all terms whose name has a suffix matching the provided `HashQualified`, -- returning terms with relative names if they exist, and otherwise -- returning terms with absolute names. -lookupRelativeHQTerm :: HashQualified Name -> NamesWithHistory -> Set Referent -lookupRelativeHQTerm hq ns@NamesWithHistory {..} = - let rs = lookupHQTerm hq ns +lookupRelativeHQTerm :: SearchType -> HashQualified Name -> NamesWithHistory -> Set Referent +lookupRelativeHQTerm searchType hq ns@NamesWithHistory {..} = + let rs = lookupHQTerm searchType hq ns keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.terms currentNames)) in case Set.filter keep rs of rs' | Set.null rs' -> rs | otherwise -> rs' -lookupRelativeHQTerm' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Referent -lookupRelativeHQTerm' = - lookupRelativeHQTerm . HQ'.toHQ +lookupRelativeHQTerm' :: SearchType -> HQ'.HashQualified Name -> NamesWithHistory -> Set Referent +lookupRelativeHQTerm' searchType = + lookupRelativeHQTerm searchType . HQ'.toHQ -- | Find all terms whose name has a suffix matching the provided 'HashQualified'. -- -- If the hash-qualified name does not include a hash, then only current names are searched. Otherwise, old names are -- searched, too, if searching current names produces no hits. -lookupHQTerm :: HashQualified Name -> NamesWithHistory -> Set Referent -lookupHQTerm = - lookupHQRef Names.terms Referent.isPrefixOf +lookupHQTerm :: SearchType -> HashQualified Name -> NamesWithHistory -> Set Referent +lookupHQTerm searchType = + lookupHQRef searchType Names.terms Referent.isPrefixOf -- | Find all terms whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQTerm'. -lookupHQTerm' :: HQ'.HashQualified Name -> NamesWithHistory -> Set Referent -lookupHQTerm' = - lookupHQTerm . HQ'.toHQ +lookupHQTerm' :: SearchType -> HQ'.HashQualified Name -> NamesWithHistory -> Set Referent +lookupHQTerm' searchType = + lookupHQTerm searchType . HQ'.toHQ -- Helper that unifies looking up a set of references/referents by a hash-qualified suffix. -- @@ -184,6 +217,7 @@ lookupHQTerm' = lookupHQRef :: forall r. (Ord r) => + SearchType -> -- | A projection of types or terms from a Names. (Names -> Relation Name r) -> -- | isPrefixOf, for references or referents @@ -192,20 +226,23 @@ lookupHQRef :: HashQualified Name -> NamesWithHistory -> Set r -lookupHQRef which isPrefixOf hq NamesWithHistory {currentNames, oldNames} = +lookupHQRef searchType which isPrefixOf hq NamesWithHistory {currentNames, oldNames} = case hq of - HQ.NameOnly n -> Name.searchByRankedSuffix n currentRefs + HQ.NameOnly n -> doSearch n currentRefs HQ.HashQualified n sh -> matches currentRefs `orIfEmpty` matches oldRefs where matches :: Relation Name r -> Set r matches ns = - Set.filter (isPrefixOf sh) (Name.searchByRankedSuffix n ns) + Set.filter (isPrefixOf sh) (doSearch n ns) HQ.HashOnly sh -> matches currentRefs `orIfEmpty` matches oldRefs where matches :: Relation Name r -> Set r matches ns = Set.filter (isPrefixOf sh) (R.ran ns) where + doSearch = case searchType of + IncludeSuffixes -> Name.searchByRankedSuffix + ExactName -> Relation.lookupDom currentRefs = which currentNames oldRefs = which oldNames @@ -261,14 +298,15 @@ termName length r NamesWithHistory {..} = -- Set HashQualified -> Branch m -> Command m i v Names -- populate historical names lookupHQPattern :: + SearchType -> HQ.HashQualified Name -> CT.ConstructorType -> NamesWithHistory -> Set ConstructorReference -lookupHQPattern hq ctt names = +lookupHQPattern searchType hq ctt names = Set.fromList [ r - | Referent.Con r ct <- toList $ lookupHQTerm hq names, + | Referent.Con r ct <- toList $ lookupHQTerm searchType hq names, ct == ctt ] diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index cf9069fef0..c667d55003 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -161,14 +161,14 @@ bindNames unsafeVarToName keepFreeTerms ns0 e = do -- !_ = trace "bindNames.free type vars: " () -- !_ = traceShow $ fst <$> freeTyVars okTm :: (v, a) -> Names.ResolutionResult v a (v, Term v a) - okTm (v, a) = case Names.lookupHQTerm (Name.convert $ unsafeVarToName v) ns of + okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, fromReferent a $ Set.findMin rs) | otherwise -> case NES.nonEmptySet rs of Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns0 refs))) - okTy (v, a) = case Names.lookupHQType (Name.convert $ unsafeVarToName v) ns of + okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of rs | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) | otherwise -> case NES.nonEmptySet rs of diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index 667e927ab4..882e8ee143 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -22,7 +22,7 @@ bindNames :: bindNames unsafeVarToName keepFree ns0 t = let ns = Names.NamesWithHistory ns0 mempty fvs = ABT.freeVarOccurrences keepFree t - rs = [(v, a, Names.lookupHQType (Name.convert $ unsafeVarToName v) ns) | (v, a) <- fvs] + rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, a, rs) = if Set.size rs == 1 then pure (v, Set.findMin rs) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 69a35deb45..f580133298 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -27,7 +27,7 @@ module Unison.Server.Backend basicSuffixifiedNames, bestNameForTerm, bestNameForType, - definitionsBySuffixes, + definitionsByName, displayType, docsInBranchToHtmlFiles, expandShortCausalHash, @@ -757,9 +757,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. @@ -784,7 +785,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 -> @@ -1006,15 +1007,15 @@ evalDocRef rt codebase r = do docsForDefinitionName :: Codebase IO Symbol Ann -> NameSearch Sqlite.Transaction -> + NamesWithHistory.SearchType -> Name -> IO [TermReference] -docsForDefinitionName codebase (NameSearch {termSearch}) name = do +docsForDefinitionName codebase (NameSearch {termSearch}) searchType name = do let potentialDocNames = [name, name Cons.:> "doc"] Codebase.runTransaction codebase do refs <- potentialDocNames & foldMapM \name -> - -- TODO: Should replace this with an exact name lookup. - lookupRelativeHQRefs' termSearch (HQ'.NameOnly name) + lookupRelativeHQRefs' termSearch searchType (HQ'.NameOnly name) filterForDocs (toList refs) where filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference] @@ -1246,14 +1247,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) diff --git a/unison-share-api/src/Unison/Server/Local/Definitions.hs b/unison-share-api/src/Unison/Server/Local/Definitions.hs index 1c4713815a..42fe0b4a62 100644 --- a/unison-share-api/src/Unison/Server/Local/Definitions.hs +++ b/unison-share-api/src/Unison/Server/Local/Definitions.hs @@ -66,11 +66,11 @@ 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 - docRefs <- docsForDefinitionName codebase nameSearch name + docRefs <- docsForDefinitionName codebase nameSearch NamesWithHistory.ExactName name renderDocRefs pped width codebase rt docRefs -- local server currently ignores doc eval errors <&> fmap \(hqn, h, doc, _errs) -> (hqn, h, doc) diff --git a/unison-share-api/src/Unison/Server/NameSearch.hs b/unison-share-api/src/Unison/Server/NameSearch.hs index 8cc5e65cd0..0d8b17987c 100644 --- a/unison-share-api/src/Unison/Server/NameSearch.hs +++ b/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 diff --git a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs b/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs index a9aa87ccd3..73e53f27f3 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/FromNames.hs +++ b/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' = pure . (`NamesWithHistory.lookupRelativeHQType'` 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' = pure . (`NamesWithHistory.lookupRelativeHQTerm'` names), + lookupRelativeHQRefs' = \searchType n -> pure $ NamesWithHistory.lookupRelativeHQTerm' searchType n names, matchesNamedRef = HQ'.matchesNamedReferent, makeResult = \hqname r names -> pure $ SR.termResult hqname r names } diff --git a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs b/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs index f87ed18901..e7fa113fa1 100644 --- a/unison-share-api/src/Unison/Server/NameSearch/Sqlite.hs +++ b/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 namesPerspective@Ops.NamesPerspective {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 namesPerspective@Ops.NamesPerspective {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 namesPerspective@Ops.NamesPerspective {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 namesPerspective@Ops.NamesPerspective {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 diff --git a/unison-src/transcripts/api-getDefinition.md b/unison-src/transcripts/api-getDefinition.md index 43d3b1b229..20fe6c867a 100644 --- a/unison-src/transcripts/api-getDefinition.md +++ b/unison-src/transcripts/api-getDefinition.md @@ -14,7 +14,7 @@ nested.names.x = 42 ``` ```api --- Should find names by suffix +-- Should NOT find names by suffix GET /api/non-project-code/getDefinition?names=x -- Term names should strip relativeTo prefix. diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md index 4a3adff2c0..6a9514ad4e 100644 --- a/unison-src/transcripts/api-getDefinition.output.md +++ b/unison-src/transcripts/api-getDefinition.output.md @@ -6,194 +6,22 @@ nested.names.x = 42 ``` ```api --- Should find names by suffix +-- Should NOT find names by suffix GET /api/non-project-code/getDefinition?names=x { - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "nested.names.x" - ] - } - }, + "missingDefinitions": [ + "x" + ], + "termDefinitions": {}, "typeDefinitions": {} } -- Term names should strip relativeTo prefix. GET /api/non-project-code/getDefinition?names=x&relativeTo=nested { - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "names.x" - ] - } - }, + "missingDefinitions": [ + "x" + ], + "termDefinitions": {}, "typeDefinitions": {} } -- Should find definitions by hash, names should be relative