Merge pull request #958 from alanz/completion-prefixes

Extend list of OccName prefixes to be filtered for completions

Author: alanz

src/Haskell/Ide/Engine/Plugin/HieExtras.hs

@@ -694,16 +694,64 @@ splitCaseCmd' uri newPos =
 
 -- ---------------------------------------------------------------------
 
-{- Under certain circumstance GHC generates some extra stuff that we don't want in the autocompleted symbols -}
+-- | Under certain circumstance GHC generates some extra stuff that we
+-- don't want in the autocompleted symbols
 stripAutoGenerated :: CompItem -> CompItem
 stripAutoGenerated ci =
-    ci {label = stripRecordSelector (label ci)}
-  where
-    {- When DuplicateRecordFields is enabled, compiler generates
+    ci {label = stripPrefix (label ci)}
+    {- When e.g. DuplicateRecordFields is enabled, compiler generates
     names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
     https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
     -}
-    stripRecordSelector :: T.Text -> T.Text
-    stripRecordSelector name
-      | T.isPrefixOf "$sel:" name = T.takeWhile (/=':') $ T.drop 5 name
-      | otherwise = name
+
+-- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
+
+stripPrefix :: T.Text -> T.Text
+stripPrefix name = T.takeWhile (/=':') $ go prefixes
+  where
+    go [] = name
+    go (p:ps)
+      | T.isPrefixOf p name = T.drop (T.length p) name
+      | otherwise = go ps
+
+-- | Prefixes that can occur in a GHC OccName
+prefixes :: [T.Text]
+prefixes =
+  [
+    -- long ones
+    "$con2tag_"
+  , "$tag2con_"
+  , "$maxtag_"
+
+  -- four chars
+  , "$sel:"
+  , "$tc'"
+
+  -- three chars
+  , "$dm"
+  , "$co"
+  , "$tc"
+  , "$cp"
+  , "$fx"
+
+  -- two chars
+  , "$W"
+  , "$w"
+  , "$m"
+  , "$b"
+  , "$c"
+  , "$d"
+  , "$i"
+  , "$s"
+  , "$f"
+  , "$r"
+  , "C:"
+  , "N:"
+  , "D:"
+  , "$p"
+  , "$L"
+  , "$f"
+  , "$t"
+  , "$c"
+  , "$m"
+  ]

test/functional/CompletionSpec.hs

@@ -120,7 +120,7 @@ spec = describe "completions" $ do
     _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
     compls <- getCompletions doc (Position 5 7)
     liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null
-  
+
   -- See https://github.com/haskell/haskell-ide-engine/issues/903
   it "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "DupRecFields.hs" "haskell"
@@ -136,7 +136,7 @@ spec = describe "completions" $ do
       item ^. kind `shouldBe` Just CiFunction
       item ^. detail `shouldBe` Just "Two -> Int\nDupRecFields"
       item ^. insertText `shouldBe` Just "accessor ${1:Two}"
-  
+
   describe "contexts" $ do
     it "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Context.hs" "haskell"
@@ -151,9 +151,9 @@ spec = describe "completions" $ do
       _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
       compls <- getCompletions doc (Position 3 9)
       liftIO $ do
-        compls `shouldContainCompl` "abs" 
+        compls `shouldContainCompl` "abs"
         compls `shouldNotContainCompl` "Applicative"
-    
+
     -- This currently fails if it takes too long to typecheck the module
     -- it "completes qualified type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     --   doc <- openDoc "Context.hs" "haskell"
@@ -175,7 +175,7 @@ spec = describe "completions" $ do
     let item = head $ filter ((== "id") . (^. label)) compls
     liftIO $
       item ^. detail `shouldBe` Just "a -> a\nPrelude"
- 
+
   it "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
     doc <- openDoc "Completion.hs" "haskell"
     _ <- skipManyTill loggingNotification (count 2 noDiagnostics)
@@ -184,7 +184,7 @@ spec = describe "completions" $ do
     compls <- getCompletions doc (Position 5 11)
     let item = head $ filter ((== "flip") . (^. label)) compls
     liftIO $
-      item ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude"     
+      item ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude"
 
   describe "snippets" $ do
     it "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do