Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 144500f

Browse files
committed
Extend list of OccName prefixes to be filtered for completions
Closes #903 (again)
1 parent af427dc commit 144500f

File tree

2 files changed

+62
-14
lines changed

2 files changed

+62
-14
lines changed

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

Lines changed: 56 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -694,16 +694,64 @@ splitCaseCmd' uri newPos =
694694

695695
-- ---------------------------------------------------------------------
696696

697-
{- Under certain circumstance GHC generates some extra stuff that we don't want in the autocompleted symbols -}
697+
-- | Under certain circumstance GHC generates some extra stuff that we
698+
-- don't want in the autocompleted symbols
698699
stripAutoGenerated :: CompItem -> CompItem
699700
stripAutoGenerated ci =
700-
ci {label = stripRecordSelector (label ci)}
701-
where
702-
{- When DuplicateRecordFields is enabled, compiler generates
701+
ci {label = stripPrefix (label ci)}
702+
{- When e.g. DuplicateRecordFields is enabled, compiler generates
703703
names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
704704
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
705705
-}
706-
stripRecordSelector :: T.Text -> T.Text
707-
stripRecordSelector name
708-
| T.isPrefixOf "$sel:" name = T.takeWhile (/=':') $ T.drop 5 name
709-
| otherwise = name
706+
707+
-- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
708+
709+
stripPrefix :: T.Text -> T.Text
710+
stripPrefix name = T.takeWhile (/=':') $ go prefixes
711+
where
712+
go [] = name
713+
go (p:ps)
714+
| T.isPrefixOf p name = T.drop (T.length p) name
715+
| otherwise = go ps
716+
717+
-- | Prefixes that can occur in a GHC OccName
718+
prefixes :: [T.Text]
719+
prefixes =
720+
[
721+
-- long ones
722+
"$con2tag_"
723+
, "$tag2con_"
724+
, "$maxtag_"
725+
726+
-- four chars
727+
, "$sel:"
728+
, "$tc'"
729+
730+
-- three chars
731+
, "$dm"
732+
, "$co"
733+
, "$tc"
734+
, "$cp"
735+
, "$fx"
736+
737+
-- two chars
738+
, "$W"
739+
, "$w"
740+
, "$m"
741+
, "$b"
742+
, "$c"
743+
, "$d"
744+
, "$i"
745+
, "$s"
746+
, "$f"
747+
, "$r"
748+
, "C:"
749+
, "N:"
750+
, "D:"
751+
, "$p"
752+
, "$L"
753+
, "$f"
754+
, "$t"
755+
, "$c"
756+
, "$m"
757+
]

test/functional/CompletionSpec.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -120,7 +120,7 @@ spec = describe "completions" $ do
120120
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
121121
compls <- getCompletions doc (Position 5 7)
122122
liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null
123-
123+
124124
-- See https://github.com/haskell/haskell-ide-engine/issues/903
125125
it "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
126126
doc <- openDoc "DupRecFields.hs" "haskell"
@@ -136,7 +136,7 @@ spec = describe "completions" $ do
136136
item ^. kind `shouldBe` Just CiFunction
137137
item ^. detail `shouldBe` Just "Two -> Int\nDupRecFields"
138138
item ^. insertText `shouldBe` Just "accessor ${1:Two}"
139-
139+
140140
describe "contexts" $ do
141141
it "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
142142
doc <- openDoc "Context.hs" "haskell"
@@ -151,9 +151,9 @@ spec = describe "completions" $ do
151151
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
152152
compls <- getCompletions doc (Position 3 9)
153153
liftIO $ do
154-
compls `shouldContainCompl` "abs"
154+
compls `shouldContainCompl` "abs"
155155
compls `shouldNotContainCompl` "Applicative"
156-
156+
157157
-- This currently fails if it takes too long to typecheck the module
158158
-- it "completes qualified type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
159159
-- doc <- openDoc "Context.hs" "haskell"
@@ -175,7 +175,7 @@ spec = describe "completions" $ do
175175
let item = head $ filter ((== "id") . (^. label)) compls
176176
liftIO $
177177
item ^. detail `shouldBe` Just "a -> a\nPrelude"
178-
178+
179179
it "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
180180
doc <- openDoc "Completion.hs" "haskell"
181181
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
@@ -184,7 +184,7 @@ spec = describe "completions" $ do
184184
compls <- getCompletions doc (Position 5 11)
185185
let item = head $ filter ((== "flip") . (^. label)) compls
186186
liftIO $
187-
item ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude"
187+
item ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude"
188188

189189
describe "snippets" $ do
190190
it "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do

0 commit comments

Comments
 (0)