Skip to content

Commit d00c3aa

Browse files
pepeiborrapepeiborra
committed
Reenable auto extend imports
1 parent 40c24f8 commit d00c3aa

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
@@ -168,6 +168,7 @@ library
168168
Development.IDE.Types.Shake
169169
Development.IDE.Plugin
170170
Development.IDE.Plugin.Completions
171+
Development.IDE.Plugin.Completions.Types
171172
Development.IDE.Plugin.CodeAction
172173
Development.IDE.Plugin.CodeAction.ExactPrint
173174
Development.IDE.Plugin.HLS
@@ -199,7 +200,6 @@ library
199200
Development.IDE.Plugin.CodeAction.Rules
200201
Development.IDE.Plugin.CodeAction.RuleTypes
201202
Development.IDE.Plugin.Completions.Logic
202-
Development.IDE.Plugin.Completions.Types
203203
Development.IDE.Plugin.HLS.Formatter
204204
Development.IDE.Types.Action
205205
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
@@ -28,6 +28,7 @@ import Development.IDE.Core.Shake (Q(..))
2828
import Development.IDE.GHC.Util
2929
import qualified Data.Text as T
3030
import Data.Typeable
31+
import Development.IDE.Plugin.Completions.Types (extendImportCommandId)
3132
import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
3233
import Development.IDE.Spans.Common
3334
import Development.IDE.Test
@@ -142,7 +143,7 @@ initializeResponseTests = withResource acquire release tests where
142143
, chk "NO doc link" _documentLinkProvider Nothing
143144
, chk "NO color" _colorProvider (Just $ ColorOptionsStatic False)
144145
, chk "NO folding range" _foldingRangeProvider (Just $ FoldingRangeOptionsStatic False)
145-
, che " execute command" _executeCommandProvider [blockCommandId, typeLensCommandId]
146+
, che " execute command" _executeCommandProvider [blockCommandId, extendImportCommandId, typeLensCommandId]
146147
, chk " workspace" _workspace (Just $ WorkspaceOptions (Just WorkspaceFolderOptions{_supported = Just True, _changeNotifications = Just ( WorkspaceFolderChangeNotificationsBool True )}))
147148
, chk "NO experimental" _experimental Nothing
148149
] where
@@ -3298,6 +3299,35 @@ completionTest name src pos expected = testSessionWait name $ do
32983299
when expectedDocs $
32993300
assertBool ("Missing docs: " <> T.unpack _label) (isJust _documentation)
33003301

3302+
completionCommandTest ::
3303+
String ->
3304+
[T.Text] ->
3305+
Position ->
3306+
T.Text ->
3307+
[T.Text] ->
3308+
TestTree
3309+
completionCommandTest name src pos wanted expected = testSession name $ do
3310+
docId <- createDoc "A.hs" "haskell" (T.unlines src)
3311+
_ <- waitForDiagnostics
3312+
compls <- getCompletions docId pos
3313+
let wantedC = find ( \case
3314+
CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
3315+
_ -> False
3316+
) compls
3317+
case wantedC of
3318+
Nothing ->
3319+
liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]
3320+
Just CompletionItem {..} -> do
3321+
c <- assertJust "Expected a command" _command
3322+
executeCommand c
3323+
if src /= expected
3324+
then do
3325+
modifiedCode <- getDocumentEdit docId
3326+
liftIO $ modifiedCode @?= T.unlines expected
3327+
else do
3328+
expectMessages @ApplyWorkspaceEditRequest 1 $ \edit ->
3329+
liftIO $ assertFailure $ "Expected no edit but got: " <> show edit
3330+
33013331
topLevelCompletionTests :: [TestTree]
33023332
topLevelCompletionTests = [
33033333
completionTest
@@ -3446,46 +3476,78 @@ nonLocalCompletionTests =
34463476
]
34473477
(Position 3 6)
34483478
[],
3449-
expectFailBecause "Auto import completion snippets were disabled in v0.6.0.2" $
3450-
testGroup "auto import snippets"
3451-
[ completionTest
3479+
testGroup "auto import snippets"
3480+
[ completionCommandTest
34523481
"show imports not in list - simple"
34533482
["{-# LANGUAGE NoImplicitPrelude #-}",
34543483
"module A where", "import Control.Monad (msum)", "f = joi"]
34553484
(Position 3 6)
3456-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3457-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 26}, _end = Position {_line = 2, _character = 26}}, _newText = "join, "}]))]
3458-
, completionTest
3485+
"join"
3486+
["{-# LANGUAGE NoImplicitPrelude #-}",
3487+
"module A where", "import Control.Monad (msum, join)", "f = joi"]
3488+
, completionCommandTest
34593489
"show imports not in list - multi-line"
34603490
["{-# LANGUAGE NoImplicitPrelude #-}",
34613491
"module A where", "import Control.Monad (\n msum)", "f = joi"]
34623492
(Position 4 6)
3463-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3464-
Just (List [TextEdit {_range = Range {_start = Position {_line = 3, _character = 8}, _end = Position {_line = 3, _character = 8}}, _newText = "join, "}]))]
3465-
, completionTest
3493+
"join"
3494+
["{-# LANGUAGE NoImplicitPrelude #-}",
3495+
"module A where", "import Control.Monad (\n msum, join)", "f = joi"]
3496+
, completionCommandTest
34663497
"show imports not in list - names with _"
34673498
["{-# LANGUAGE NoImplicitPrelude #-}",
34683499
"module A where", "import qualified Control.Monad as M (msum)", "f = M.mapM_"]
34693500
(Position 3 11)
3470-
[("mapM_", CiFunction, "mapM_ ${1:a -> m b} ${2:t a}", False, False,
3471-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 41}, _end = Position {_line = 2, _character = 41}}, _newText = "mapM_, "}]))]
3472-
, completionTest
3501+
"mapM_"
3502+
["{-# LANGUAGE NoImplicitPrelude #-}",
3503+
"module A where", "import qualified Control.Monad as M (msum, mapM_)", "f = M.mapM_"]
3504+
, completionCommandTest
34733505
"show imports not in list - initial empty list"
34743506
["{-# LANGUAGE NoImplicitPrelude #-}",
34753507
"module A where", "import qualified Control.Monad as M ()", "f = M.joi"]
34763508
(Position 3 10)
3477-
[("join", CiFunction, "join ${1:m (m a)}", False, False,
3478-
Just (List [TextEdit {_range = Range {_start = Position {_line = 2, _character = 37}, _end = Position {_line = 2, _character = 37}}, _newText = "join, "}]))]
3479-
, completionTest
3480-
"record snippet on import"
3481-
["module A where", "import Text.Printf (FormatParse(FormatParse))", "FormatParse"]
3482-
(Position 2 10)
3483-
[("FormatParse", CiStruct, "FormatParse ", False, False,
3484-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}])),
3485-
("FormatParse", CiConstructor, "FormatParse ${1:String} ${2:Char} ${3:String}", False, False,
3486-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}])),
3487-
("FormatParse", CiSnippet, "FormatParse {fpModifiers=${1:_fpModifiers}, fpChar=${2:_fpChar}, fpRest=${3:_fpRest}}", False, False,
3488-
Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}]))
3509+
"join"
3510+
["{-# LANGUAGE NoImplicitPrelude #-}",
3511+
"module A where", "import qualified Control.Monad as M (join)", "f = M.joi"]
3512+
, testGroup "Data constructor"
3513+
[ completionCommandTest
3514+
"not imported"
3515+
["module A where", "import Text.Printf ()", "ZeroPad"]
3516+
(Position 2 4)
3517+
"ZeroPad"
3518+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3519+
, completionCommandTest
3520+
"parent imported"
3521+
["module A where", "import Text.Printf (FormatAdjustment)", "ZeroPad"]
3522+
(Position 2 4)
3523+
"ZeroPad"
3524+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3525+
, completionCommandTest
3526+
"already imported"
3527+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3528+
(Position 2 4)
3529+
"ZeroPad"
3530+
["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
3531+
]
3532+
, testGroup "Record completion"
3533+
[ completionCommandTest
3534+
"not imported"
3535+
["module A where", "import Text.Printf ()", "FormatParse"]
3536+
(Position 2 10)
3537+
"FormatParse {"
3538+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3539+
, completionCommandTest
3540+
"parent imported"
3541+
["module A where", "import Text.Printf (FormatParse)", "FormatParse"]
3542+
(Position 2 10)
3543+
"FormatParse {"
3544+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3545+
, completionCommandTest
3546+
"already imported"
3547+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
3548+
(Position 2 10)
3549+
"FormatParse {"
3550+
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
34893551
]
34903552
],
34913553
-- 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)