Skip to content

Commit a950538

Browse files
pepeiborrapepeiborra
committed
Reenable auto extend imports
1 parent 239fbde commit a950538

File tree

4 files changed

+108
-36
lines changed

4 files changed

+108
-36
lines changed

‎ghcide/ghcide.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,7 @@ library
173173
Development.IDE.Types.Shake
174174
Development.IDE.Plugin
175175
Development.IDE.Plugin.Completions
176+
Development.IDE.Plugin.Completions.Types
176177
Development.IDE.Plugin.CodeAction
177178
Development.IDE.Plugin.CodeAction.ExactPrint
178179
Development.IDE.Plugin.HLS
@@ -204,7 +205,6 @@ library
204205
Development.IDE.Plugin.CodeAction.Rules
205206
Development.IDE.Plugin.CodeAction.RuleTypes
206207
Development.IDE.Plugin.Completions.Logic
207-
Development.IDE.Plugin.Completions.Types
208208
Development.IDE.Plugin.HLS.Formatter
209209
Development.IDE.Types.Action
210210
ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns

‎ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -284,6 +284,8 @@ cacheDataProducer uri packageState curMod rdrEnv limports deps = do
284284
let dflags = hsc_dflags packageState
285285
curModName = moduleName curMod
286286

287+
importMap = Map.fromList [ (getLoc imp, imp) | imp <- limports ]
288+
287289
iDeclToModName :: ImportDecl name -> ModuleName
288290
iDeclToModName = unLoc . ideclName
289291

@@ -312,7 +314,8 @@ cacheDataProducer uri packageState curMod rdrEnv limports deps = do
312314
(, mempty) <$> toCompItem par curMod curModName n Nothing
313315
getComplsForOne (GRE n par False prov) =
314316
flip foldMapM (map is_decl prov) $ \spec -> do
315-
compItem <- toCompItem curMod (is_mod spec) n Nothing
317+
let originalImportDecl = Map.lookup (is_dloc spec) importMap
318+
compItem <- toCompItem par curMod (is_mod spec) n originalImportDecl
316319
let unqual
317320
| is_qual spec = []
318321
| otherwise = compItem

‎ghcide/test/exe/Main.hs

Lines changed: 87 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import Development.IDE.Core.Shake (Q(..))
3030
import Development.IDE.GHC.Util
3131
import qualified Data.Text as T
3232
import Data.Typeable
33+
import Development.IDE.Plugin.Completions.Types (extendImportCommandId)
3334
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
3435
import Development.IDE.Spans.Common
3536
import Development.IDE.Test
@@ -146,7 +147,7 @@ initializeResponseTests = withResource acquire release tests where
146147
, chk "NO doc link" _documentLinkProvider Nothing
147148
, chk "NO color" _colorProvider (Just $ ColorOptionsStatic False)
148149
, chk "NO folding range" _foldingRangeProvider (Just $ FoldingRangeOptionsStatic False)
149-
, che " execute command" _executeCommandProvider [blockCommandId, typeLensCommandId]
150+
, che " execute command" _executeCommandProvider [blockCommandId, extendImportCommandId, typeLensCommandId]
150151
, chk " workspace" _workspace (Just $ WorkspaceOptions (Just WorkspaceFolderOptions{_supported = Just True, _changeNotifications = Just ( WorkspaceFolderChangeNotificationsBool True )}))
151152
, chk "NO experimental" _experimental Nothing
152153
] where
@@ -3303,6 +3304,35 @@ completionTest name src pos expected = testSessionWait name $ do
33033304
when expectedDocs $
33043305
assertBool ("Missing docs: " <> T.unpack _label) (isJust _documentation)
33053306

3307+
completionCommandTest ::
3308+
String ->
3309+
[T.Text] ->
3310+
Position ->
3311+
T.Text ->
3312+
[T.Text] ->
3313+
TestTree
3314+
completionCommandTest name src pos wanted expected = testSession name $ do
3315+
docId <- createDoc "A.hs" "haskell" (T.unlines src)
3316+
_ <- waitForDiagnostics
3317+
compls <- getCompletions docId pos
3318+
let wantedC = find ( \case
3319+
CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
3320+
_ -> False
3321+
) compls
3322+
case wantedC of
3323+
Nothing ->
3324+
liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]
3325+
Just CompletionItem {..} -> do
3326+
c <- assertJust "Expected a command" _command
3327+
executeCommand c
3328+
if src /= expected
3329+
then do
3330+
modifiedCode <- getDocumentEdit docId
3331+
liftIO $ modifiedCode @?= T.unlines expected
3332+
else do
3333+
expectMessages @ApplyWorkspaceEditRequest 1 $ \edit ->
3334+
liftIO $ assertFailure $ "Expected no edit but got: " <> show edit
3335+
33063336
topLevelCompletionTests :: [TestTree]
33073337
topLevelCompletionTests = [
33083338
completionTest
@@ -3451,46 +3481,78 @@ nonLocalCompletionTests =
34513481
]
34523482
(Position 3 6)
34533483
[],
3454-
expectFailBecause "Auto import completion snippets were disabled in v0.6.0.2" $
3455-
testGroup "auto import snippets"
3456-
[ completionTest
3484+
testGroup "auto import snippets"
3485+
[ completionCommandTest
34573486
"show imports not in list - simple"
34583487
["{-# LANGUAGE NoImplicitPrelude #-}",
34593488
"module A where", "import Control.Monad (msum)", "f = joi"]
34603489
(Position 3 6)
3461-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3462-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 26}, _end = Position {_line = 2, _character = 26}}, _newText = "join, "}]))]
3463-
, completionTest
3490+
"join"
3491+
["{-# LANGUAGE NoImplicitPrelude #-}",
3492+
"module A where", "import Control.Monad (msum, join)", "f = joi"]
3493+
, completionCommandTest
34643494
"show imports not in list - multi-line"
34653495
["{-# LANGUAGE NoImplicitPrelude #-}",
34663496
"module A where", "import Control.Monad (\n msum)", "f = joi"]
34673497
(Position 4 6)
3468-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3469-
Just (List [TextEdit {_range = Range {_start = Position {_line = 3, _character = 8}, _end = Position {_line = 3, _character = 8}}, _newText = "join, "}]))]
3470-
, completionTest
3498+
"join"
3499+
["{-# LANGUAGE NoImplicitPrelude #-}",
3500+
"module A where", "import Control.Monad (\n msum, join)", "f = joi"]
3501+
, completionCommandTest
34713502
"show imports not in list - names with _"
34723503
["{-# LANGUAGE NoImplicitPrelude #-}",
34733504
"module A where", "import qualified Control.Monad as M (msum)", "f = M.mapM_"]
34743505
(Position 3 11)
3475-
[("mapM_", CiFunction, "mapM_ ${1:a -> m b} ${2:t a}", False, False,
3476-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 41}, _end = Position {_line = 2, _character = 41}}, _newText = "mapM_, "}]))]
3477-
, completionTest
3506+
"mapM_"
3507+
["{-# LANGUAGE NoImplicitPrelude #-}",
3508+
"module A where", "import qualified Control.Monad as M (msum, mapM_)", "f = M.mapM_"]
3509+
, completionCommandTest
34783510
"show imports not in list - initial empty list"
34793511
["{-# LANGUAGE NoImplicitPrelude #-}",
34803512
"module A where", "import qualified Control.Monad as M ()", "f = M.joi"]
34813513
(Position 3 10)
3482-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3483-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 37}, _end = Position {_line = 2, _character = 37}}, _newText = "join, "}]))]
3484-
, completionTest
3485-
"record snippet on import"
3486-
["module A where", "import Text.Printf (FormatParse(FormatParse))", "FormatParse"]
3487-
(Position 2 10)
3488-
[("FormatParse", CiStruct, "FormatParse ", False, False,
3489-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}])),
3490-
("FormatParse", CiConstructor, "FormatParse ${1:String} ${2:Char} ${3:String}", False, False,
3491-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}])),
3492-
("FormatParse", CiSnippet, "FormatParse {fpModifiers=${1:_fpModifiers}, fpChar=${2:_fpChar}, fpRest=${3:_fpRest}}", False, False,
3493-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}]))
3514+
"join"
3515+
["{-# LANGUAGE NoImplicitPrelude #-}",
3516+
"module A where", "import qualified Control.Monad as M (join)", "f = M.joi"]
3517+
, testGroup "Data constructor"
3518+
[ completionCommandTest
3519+
"not imported"
3520+
["module A where", "import Text.Printf ()", "ZeroPad"]
3521+
(Position 2 4)
3522+
"ZeroPad"
3523+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3524+
, completionCommandTest
3525+
"parent imported"
3526+
["module A where", "import Text.Printf (FormatAdjustment)", "ZeroPad"]
3527+
(Position 2 4)
3528+
"ZeroPad"
3529+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3530+
, completionCommandTest
3531+
"already imported"
3532+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3533+
(Position 2 4)
3534+
"ZeroPad"
3535+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3536+
]
3537+
, testGroup "Record completion"
3538+
[ completionCommandTest
3539+
"not imported"
3540+
["module A where", "import Text.Printf ()", "FormatParse"]
3541+
(Position 2 10)
3542+
"FormatParse {"
3543+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3544+
, completionCommandTest
3545+
"parent imported"
3546+
["module A where", "import Text.Printf (FormatParse)", "FormatParse"]
3547+
(Position 2 10)
3548+
"FormatParse {"
3549+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3550+
, completionCommandTest
3551+
"already imported"
3552+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3553+
(Position 2 10)
3554+
"FormatParse {"
3555+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
34943556
]
34953557
],
34963558
-- we need this test to make sure the ghcide completions module does not return completions for language pragmas. this functionality is turned on in hls

‎ghcide/test/src/Development/IDE/Test.hs

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module Development.IDE.Test
1111
, expectDiagnostics
1212
, expectDiagnosticsWithTags
1313
, expectNoMoreDiagnostics
14+
, expectMessages
1415
, expectCurrentDiagnostics
1516
, checkDiagnosticsForDoc
1617
, canonicalizeUri
@@ -35,6 +36,8 @@ import Test.Tasty.HUnit
3536
import System.Directory (canonicalizePath)
3637
import Data.Maybe (fromJust)
3738
import Development.IDE.Plugin.Test (WaitForIdeRuleResult, TestRequest(WaitForIdeRule))
39+
import Data.Aeson (FromJSON)
40+
import Data.Typeable (Typeable)
3841

3942

4043
-- | (0-based line number, 0-based column number)
@@ -66,7 +69,18 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag)
6669
-- |wait for @timeout@ seconds and report an assertion failure
6770
-- if any diagnostic messages arrive in that period
6871
expectNoMoreDiagnostics :: Seconds -> Session ()
69-
expectNoMoreDiagnostics timeout = do
72+
expectNoMoreDiagnostics timeout =
73+
expectMessages @PublishDiagnosticsNotification timeout $ \diagsNot -> do
74+
let fileUri = diagsNot ^. params . uri
75+
actual = diagsNot ^. params . diagnostics
76+
liftIO $
77+
assertFailure $
78+
"Got unexpected diagnostics for " <> show fileUri
79+
<> " got "
80+
<> show actual
81+
82+
expectMessages :: (FromJSON msg, Typeable msg) => Seconds -> (msg -> Session ()) -> Session ()
83+
expectMessages timeout handle = do
7084
-- Give any further diagnostic messages time to arrive.
7185
liftIO $ sleep timeout
7286
-- Send a dummy message to provoke a response from the server.
@@ -75,14 +89,7 @@ expectNoMoreDiagnostics timeout = do
7589
void $ sendRequest (CustomClientMethod "non-existent-method") ()
7690
handleMessages
7791
where
78-
handleMessages = handleDiagnostic <|> handleCustomMethodResponse <|> ignoreOthers
79-
handleDiagnostic = do
80-
diagsNot <- LspTest.message :: Session PublishDiagnosticsNotification
81-
let fileUri = diagsNot ^. params . uri
82-
actual = diagsNot ^. params . diagnostics
83-
liftIO $ assertFailure $
84-
"Got unexpected diagnostics for " <> show fileUri <>
85-
" got " <> show actual
92+
handleMessages = (LspTest.message >>= handle) <|> handleCustomMethodResponse <|> ignoreOthers
8693
ignoreOthers = void anyMessage >> handleMessages
8794

8895
handleCustomMethodResponse :: Session ()

0 commit comments

Comments
 (0)