Rewrite name results to be only valid prefixes

Author: ChrisPenner

src/Share/Web/Share/Impl.hs

@@ -380,14 +380,36 @@ searchDefinitionNamesEndpoint ::
   Maybe IDs.ProjectShortHand ->
   Maybe IDs.ReleaseVersion ->
   WebApp [DefinitionNameSearchResult]
-searchDefinitionNamesEndpoint callerUserId query mayLimit userFilter projectFilter releaseFilter = do
+searchDefinitionNamesEndpoint callerUserId query@(Query queryText) mayLimit userFilter projectFilter releaseFilter = do
   filter <- runMaybeT $ resolveProjectAndReleaseFilter projectFilter releaseFilter <|> resolveUserFilter userFilter
-  matches <- PG.runTransaction $ DDQ.defNameInfixSearch callerUserId filter query limit
+  matches <-
+    (PG.runTransaction $ DDQ.defNameInfixSearch callerUserId filter query limit)
+      <&> over (traversed . _3) (rewriteMatches queryText)
   let response = matches <&> \(_projId, _releaseId, name, tag) -> DefinitionNameSearchResult name tag
   pure response
   where
     limit = fromMaybe (Limit 20) mayLimit
 
+    -- Try to rewrite the name to only include the part of the name that matches the query,
+    -- and any following suffix.
+    -- >>> Name.toText $ rewriteMatches "foo" (Name.unsafeParseText "foo.bar.baz")
+    -- "foo.bar.baz"
+    --
+    -- >>> Name.toText $ rewriteMatches "List.ma" (Name.unsafeParseText "data.List.map")
+    -- "List.map"
+    --
+    -- No match; we shouldn't get these back from the query, but if we do, just return the name as is.
+    -- >>> Name.toText $ rewriteMatches "foo" (Name.unsafeParseText "bar.baz")
+    -- "bar.baz"
+    rewriteMatches :: Text -> Name -> Name
+    rewriteMatches q name
+      | nameText <- Name.toText name,
+        Text.isInfixOf q nameText =
+          let (_before, after) = Text.breakOnEnd q nameText
+           in Name.parseText (q <> after)
+                & fromMaybe name
+      | otherwise = name
+
 resolveProjectAndReleaseFilter :: Maybe IDs.ProjectShortHand -> Maybe IDs.ReleaseVersion -> MaybeT WebApp DDQ.DefnNameSearchFilter
 resolveProjectAndReleaseFilter projectFilter releaseFilter = do
   projectShortHand <- hoistMaybe projectFilter

transcripts/share-apis/search/complex-type-mention-search.json

@@ -145,7 +145,7 @@
           },
           "tag": "Plain"
         },
-        "fqn": "List.map",
+        "fqn": "data.List.map",
         "kind": "term",
         "projectRef": "@transcripts/search"
       }

transcripts/share-apis/search/create-release.json

@@ -1,7 +1,7 @@
 {
   "body": {
-    "causalHashSquashed": "#k64a0e0j4goec5ktrql2q8knot22dakbks05kno7jvr5fha3c894o6hhbkusi7tqegk024d9trmh0v7hikbjn6rrsura5tuecg1bt8o",
-    "causalHashUnsquashed": "#1d13nals2i51pbupql9vm16qqsvr9svld305f5uijrslk26vuqunq9sd3mqqsn8lsecgocdmn7fr7cujgppsp3lie9j1fc68mfeua28",
+    "causalHashSquashed": "#kgss2635bbm50dqgut16165dpivfb9tfecrpijpoc018699fti92jf9e8bh9pr3fe18qbnk1h70g9fj1oh6j3ea0gsia3rocee286k0",
+    "causalHashUnsquashed": "#41ut9c720q056bp558lo9in3jlo3p75f9hrt3b5hv3nqdmtitr79aihkmk4p0vsh2g4o2kdd3nts5gskmpagceti5rbtunilghdgi58",
     "createdAt": "<TIMESTAMP>",
     "createdBy": "@transcripts",
     "projectRef": "@transcripts/search",

transcripts/share-apis/search/name-search-infix.json

@@ -0,0 +1,13 @@
+{
+  "body": [
+    {
+      "tag": "plain",
+      "token": "List.map"
+    }
+  ],
+  "status": [
+    {
+      "status_code": 200
+    }
+  ]
+}

transcripts/share-apis/search/name-search-suffix.json

@@ -2,7 +2,7 @@
   "body": [
     {
       "tag": "plain",
-      "token": "function.const"
+      "token": "const"
     }
   ],
   "status": [

transcripts/share-apis/search/prelude.md

@@ -15,8 +15,8 @@ function.const a b = a
 structural ability Throw e where
   throw : e -> a
 
-List.map : (a -> {g} b) -> List a -> {g} List b
-List.map f = cases
+data.List.map : (a -> {g} b) -> List a -> {g} List b
+data.List.map f = cases
   (Cons a rest) -> Cons (f a) (List.map f rest)
   Nil -> Nil
 

transcripts/share-apis/search/run.zsh

@@ -38,6 +38,7 @@ done
 # Name searches
 fetch "$transcript_user" GET 'name-search-suffix' '/search-names?query=const'
 fetch "$transcript_user" GET 'name-search-prefix' '/search-names?query=Func'
+fetch "$transcript_user" GET 'name-search-infix' '/search-names?query=List.ma'
 
 # Type searches
 # "b -> a -> a"

transcripts/share-apis/search/similar-type-search.json

@@ -145,7 +145,7 @@
           },
           "tag": "Plain"
         },
-        "fqn": "List.map",
+        "fqn": "data.List.map",
         "kind": "term",
         "projectRef": "@transcripts/search"
       }

transcripts/share-apis/search/type-var-search.json

@@ -207,7 +207,7 @@
           },
           "tag": "Plain"
         },
-        "fqn": "List.map",
+        "fqn": "data.List.map",
         "kind": "term",
         "projectRef": "@transcripts/search"
       }