Strip off the mount path of the name lookup when searching for docs

unison-core/src/Unison/Name.hs

@@ -18,6 +18,7 @@ module Unison.Name
     endsWithReverseSegments,
     endsWithSegments,
     stripReversedPrefix,
+    tryStripReversedPrefix,
     reverseSegments,
     segments,
     suffixes,
@@ -160,18 +161,32 @@ endsWithReverseSegments :: Name -> [NameSegment] -> Bool
 endsWithReverseSegments (Name _ ss0) ss1 =
   List.NonEmpty.isPrefixOf ss1 ss0
 
--- >>> stripReversedPrefix "a.b.c" ["b", "a"]
--- Just c
--- >>> stripReversedPrefix "x.y" ["b", "a"]
--- Nothing
--- >>> stripReversedPrefix "a.b" ["b", "a"]
+-- >>> stripReversedPrefix (fromReverseSegments ("c" :| ["b", "a"])) ["b", "a"]
+-- Just (Name Relative (NameSegment {toText = "c"} :| []))
+-- >>> stripReversedPrefix (fromReverseSegments ("y" :| ["x"])) ["b", "a"]
 -- Nothing
+--
+-- >>> stripReversedPrefix (fromReverseSegments ("c" :| ["b", "a"])) ["b", "a"]
+-- Just (Name Relative (NameSegment {toText = "c"} :| []))
 stripReversedPrefix :: Name -> [NameSegment] -> Maybe Name
 stripReversedPrefix (Name p segs) suffix = do
   stripped <- List.stripSuffix suffix (toList segs)
   nonEmptyStripped <- List.NonEmpty.nonEmpty stripped
   pure $ Name p nonEmptyStripped
 
+-- | Like 'stripReversedPrefix' but if the prefix doesn't match, or if it would strip the
+-- entire name away just return the original name.
+--
+-- >>> tryStripReversedPrefix (fromReverseSegments ("c" :| ["b", "a"])) ["b", "a"]
+-- Name Relative (NameSegment {toText = "c"} :| [])
+-- >>> tryStripReversedPrefix (fromReverseSegments ("y" :| ["x"])) ["b", "a"]
+-- Name Relative (NameSegment {toText = "y"} :| [NameSegment {toText = "x"}])
+--
+-- >>> tryStripReversedPrefix (fromReverseSegments ("c" :| ["b", "a"])) ["b", "a"]
+-- Name Relative (NameSegment {toText = "c"} :| [])
+tryStripReversedPrefix :: Name -> [NameSegment] -> Name
+tryStripReversedPrefix n s = fromMaybe n (stripReversedPrefix n s)
+
 -- | @isPrefixOf x y@ returns whether @x@ is a prefix of (or equivalent to) @y@, which is false if one name is relative
 -- and the other is absolute.
 --

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

@@ -42,17 +42,21 @@ nameSearchForPerspective :: Codebase m v a -> Ops.NamesPerspective -> (NameSearc
 nameSearchForPerspective codebase namesPerspective@Ops.NamesPerspective {pathToMountedNameLookup} = do
   NameSearch {typeSearch, termSearch}
   where
+    -- Some searches will provide a fully-qualified name, so we need to strip off the
+    -- mount-path before we search or it will fail to find anything.
+    stripMountPathPrefix :: Name -> Name
+    stripMountPathPrefix name = Name.tryStripReversedPrefix name (reverse $ coerce pathToMountedNameLookup)
     typeSearch =
       Search
         { lookupNames = lookupNamesForTypes,
-          lookupRelativeHQRefs' = lookupRelativeHQRefsForTypes,
+          lookupRelativeHQRefs' = lookupRelativeHQRefsForTypes . fmap stripMountPathPrefix,
           makeResult = \hqname r names -> pure $ SR.typeResult hqname r names,
           matchesNamedRef = HQ'.matchesNamedReference
         }
     termSearch =
       Search
         { lookupNames = lookupNamesForTerms,
-          lookupRelativeHQRefs' = lookupRelativeHQRefsForTerms,
+          lookupRelativeHQRefs' = lookupRelativeHQRefsForTerms . fmap stripMountPathPrefix,
           makeResult = \hqname r names -> pure $ SR.termResult hqname r names,
           matchesNamedRef = HQ'.matchesNamedReferent
         }

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

@@ -90,7 +90,9 @@ definitionForHQName perspective rootHash renderWidth suffixifyBindings rt codeba
   let width = mayDefaultWidth renderWidth
   let docResults :: Name -> Backend IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
       docResults name = do
+        Debug.debugM Debug.Server "definitionForHQName: looking up docs for name" name
         docRefs <- liftIO $ docsForDefinitionName codebase nameSearch name
+        Debug.debugM Debug.Server "definitionForHQName: Found these docs" docRefs
         renderDocRefs ppedBuilder width codebase rt docRefs
 
   let drDeps = definitionResultsDependencies dr