Skip to content
This repository was archived by the owner on Jan 2, 2021. It is now read-only.

Commit fe6044b

Browse files
pepeiborrapepeiborra
committed
Suggestions for missing imports from local modules
1 parent 5c6eae7 commit fe6044b

File tree

7 files changed

+67
-60
lines changed

7 files changed

+67
-60
lines changed

‎session-loader/Development/IDE/Session.hs

+7-2
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Development.IDE.Core.RuleTypes
3838
import Development.IDE.GHC.Util
3939
import Development.IDE.Session.VersionCheck
4040
import Development.IDE.Types.Diagnostics
41+
import Development.IDE.Types.Exports
4142
import Development.IDE.Types.Location
4243
import Development.IDE.Types.Logger
4344
import Development.IDE.Types.Options
@@ -286,8 +287,12 @@ loadSession dir = do
286287
liftIO $ modifyVar_ knownFilesVar $ traverseHashed $ pure . HashSet.union (HashSet.fromList cfps')
287288
mmt <- uses GetModificationTime cfps'
288289
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
289-
when checkProject $
290-
void $ uses GetModIface cs_exist
290+
when checkProject $ do
291+
modIfaces <- uses GetModIface cs_exist
292+
-- update xports map
293+
extras <- getShakeExtras
294+
let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
295+
liftIO $ modifyVar_ (exportsMap extras) $ return . (exportsMap' <>)
291296
pure opts
292297

293298
-- | Run the specific cradle on a specific FilePath via hie-bios.

‎src/Development/IDE/Core/OfInterest.hs

+8-2
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,13 @@ import qualified Data.Text as T
2626
import Data.Tuple.Extra
2727
import Development.Shake
2828

29+
import Development.IDE.Types.Exports
2930
import Development.IDE.Types.Location
3031
import Development.IDE.Types.Logger
3132
import Development.IDE.Core.RuleTypes
3233
import Development.IDE.Core.Shake
33-
import Control.Monad
34+
import Data.Maybe (mapMaybe)
35+
import GhcPlugins (HomeModInfo(hm_iface))
3436

3537
newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))
3638
instance IsIdeGlobal OfInterestVar
@@ -88,5 +90,9 @@ kick = mkDelayedAction "kick" Debug $ do
8890
files <- getFilesOfInterest
8991
ShakeExtras{progressUpdate} <- getShakeExtras
9092
liftIO $ progressUpdate KickStarted
91-
void $ uses TypeCheck $ HashSet.toList files
93+
results <- uses TypeCheck $ HashSet.toList files
94+
ShakeExtras{exportsMap} <- getShakeExtras
95+
let modIfaces = mapMaybe (fmap (hm_iface . tmrModInfo)) results
96+
!exportsMap' = createExportsMap modIfaces
97+
liftIO $ modifyVar_ exportsMap $ return . (exportsMap' <>)
9298
liftIO $ progressUpdate KickCompleted

‎src/Development/IDE/Core/Shake.hs

+4
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,7 @@ import qualified Development.IDE.Types.Logger as Logger
8787
import Language.Haskell.LSP.Diagnostics
8888
import qualified Data.SortedList as SL
8989
import Development.IDE.Types.Diagnostics
90+
import Development.IDE.Types.Exports
9091
import Development.IDE.Types.Location
9192
import Development.IDE.Types.Options
9293
import Control.Concurrent.Async
@@ -153,6 +154,8 @@ data ShakeExtras = ShakeExtras
153154
,restartShakeSession :: [DelayedAction ()] -> IO ()
154155
,ideNc :: IORef NameCache
155156
,knownFilesVar :: Var (Hashed (HSet.HashSet NormalizedFilePath))
157+
-- | A mapping of exported identifiers for local modules. Updated on kick
158+
,exportsMap :: Var ExportsMap
156159
}
157160

158161
type WithProgressFunc = forall a.
@@ -411,6 +414,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
411414
progressAsync <- async $
412415
when reportProgress $
413416
progressThread mostRecentProgressEvent inProgress
417+
exportsMap <- newVar HMap.empty
414418

415419
pure (ShakeExtras{..}, cancel progressAsync)
416420
(shakeDbM, shakeClose) <-

‎src/Development/IDE/Plugin/CodeAction.hs

+4-1
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ import Control.Arrow ((>>>))
5858
import Data.Functor
5959
import Control.Applicative ((<|>))
6060
import Safe (atMay)
61+
import Control.Concurrent.Extra (readVar)
6162

6263
plugin :: Plugin c
6364
plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
@@ -83,10 +84,12 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
8384
<*> use GhcSession `traverse` mbFile
8485
-- This is quite expensive 0.6-0.7s on GHC
8586
pkgExports <- runAction "CodeAction:PackageExports" state $ (useNoFile_ . PackageExports) `traverse` env
87+
localExports <- readVar (exportsMap $ shakeExtras state)
88+
let exportsMap = Map.unionWith (<>) localExports (fromMaybe mempty pkgExports)
8689
let dflags = hsc_dflags . hscEnv <$> env
8790
pure $ Right
8891
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
89-
| x <- xs, (title, tedit) <- suggestAction dflags (fromMaybe mempty pkgExports) ideOptions ( join parsedModule ) text x
92+
| x <- xs, (title, tedit) <- suggestAction dflags exportsMap ideOptions ( join parsedModule ) text x
9093
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
9194
]
9295

‎src/Development/IDE/Plugin/CodeAction/Rules.hs

+8-24
Original file line numberDiff line numberDiff line change
@@ -3,26 +3,17 @@ module Development.IDE.Plugin.CodeAction.Rules
33
)
44
where
55

6-
import Data.HashMap.Strict ( fromListWith )
7-
import Data.Text ( Text
8-
, pack
9-
)
106
import Data.Traversable ( forM )
117
import Development.IDE.Core.Rules
128
import Development.IDE.GHC.Util
139
import Development.IDE.Plugin.CodeAction.RuleTypes
10+
import Development.IDE.Types.Exports
1411
import Development.Shake
1512
import GHC ( DynFlags(pkgState) )
16-
import HscTypes ( IfaceExport
17-
, hsc_dflags
18-
, mi_exports
19-
)
13+
import HscTypes ( hsc_dflags)
2014
import LoadIface
2115
import Maybes
22-
import Module ( Module(..)
23-
, ModuleName
24-
, moduleNameString
25-
)
16+
import Module ( Module(..) )
2617
import Packages ( explicitPackages
2718
, exposedModules
2819
, packageConfigId
@@ -43,19 +34,12 @@ rulePackageExports = defineNoFile $ \(PackageExports session) -> do
4334
, (mn, _) <- exposedModules pkg
4435
]
4536

46-
results <- forM targets $ \(pkg, mn) -> do
37+
modIfaces <- forM targets $ \(pkg, mn) -> do
4738
modIface <- liftIO $ initIfaceLoad env $ loadInterface
4839
""
4940
(Module (packageConfigId pkg) mn)
5041
(ImportByUser False)
51-
case modIface of
52-
Failed _err -> return mempty
53-
Succeeded mi -> do
54-
let avails = mi_exports mi
55-
return $ concatMap (unpackAvail mn) avails
56-
return $ fromListWith (++) $ concat results
57-
58-
unpackAvail :: ModuleName -> IfaceExport -> [(Text, [(IdentInfo, Text)])]
59-
unpackAvail mod =
60-
map (\id@IdentInfo {..} -> (name, [(id, pack $ moduleNameString mod)]))
61-
. mkIdentInfos
42+
return $ case modIface of
43+
Failed _err -> Nothing
44+
Succeeded mi -> Just mi
45+
return $ createExportsMap (catMaybes modIfaces)

‎test/data/hover/GotoHover.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{- HLINT ignore -}
3-
module Testing ( module Testing ) where
3+
module GotoHover ( module GotoHover) where
44
import Data.Text (Text, pack)
55
import Foo (Bar, foo)
66

‎test/exe/Main.hs

+35-30
Original file line numberDiff line numberDiff line change
@@ -1006,7 +1006,10 @@ suggestImportTests = testGroup "suggest import actions"
10061006
, test False [] "f = quickCheck" [] "import Test.QuickCheck (quickCheck)"
10071007
]
10081008
, testGroup "want suggestion"
1009-
[ test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
1009+
[ test True [] "f = foo" [] "import Foo (foo)"
1010+
, test True [] "f = Bar" [] "import Bar (Bar(Bar))"
1011+
, test True [] "f :: Bar" [] "import Bar (Bar)"
1012+
, test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
10101013
, test True [] "f = (:|)" [] "import Data.List.NonEmpty (NonEmpty((:|)))"
10111014
, test True [] "f :: Natural" ["f = undefined"] "import Numeric.Natural (Natural)"
10121015
, test True [] "f :: NonEmpty ()" ["f = () :| []"] "import Data.List.NonEmpty (NonEmpty)"
@@ -1028,12 +1031,13 @@ suggestImportTests = testGroup "suggest import actions"
10281031
]
10291032
]
10301033
where
1031-
test wanted imps def other newImp = testSession' (T.unpack def) $ \dir -> do
1034+
test wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do
10321035
let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
10331036
after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
1034-
cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -]}}"
1037+
cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, GotoHover]}}"
10351038
liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
10361039
doc <- createDoc "Test.hs" "haskell" before
1040+
void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
10371041
_diags <- waitForDiagnostics
10381042
let defLine = length imps + 1
10391043
range = Range (Position defLine 0) (Position defLine maxBound)
@@ -1672,8 +1676,8 @@ exportUnusedTests = testGroup "export unused actions"
16721676
Nothing -- codeaction should not be available
16731677
, testSession "not top-level" $ template
16741678
(T.unlines
1675-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1676-
, "{-# OPTIONS_GHC -Wunused-binds #-}"
1679+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1680+
, "{-# OPTIONS_GHC -Wunused-binds #-}"
16771681
, "module A (foo,bar) where"
16781682
, "foo = ()"
16791683
, " where bar = ()"
@@ -1708,26 +1712,26 @@ exportUnusedTests = testGroup "export unused actions"
17081712
(R 3 0 3 3)
17091713
"Export ‘foo’"
17101714
(Just $ T.unlines
1711-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1715+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17121716
, "module A ("
17131717
, "foo) where"
17141718
, "foo = id"])
17151719
, testSession "single line explicit exports" $ template
17161720
(T.unlines
1717-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1721+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17181722
, "module A (foo) where"
17191723
, "foo = id"
17201724
, "bar = foo"])
17211725
(R 3 0 3 3)
17221726
"Export ‘bar’"
17231727
(Just $ T.unlines
1724-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1728+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17251729
, "module A (foo,bar) where"
17261730
, "foo = id"
17271731
, "bar = foo"])
17281732
, testSession "multi line explicit exports" $ template
17291733
(T.unlines
1730-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1734+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17311735
, "module A"
17321736
, " ("
17331737
, " foo) where"
@@ -1736,15 +1740,15 @@ exportUnusedTests = testGroup "export unused actions"
17361740
(R 5 0 5 3)
17371741
"Export ‘bar’"
17381742
(Just $ T.unlines
1739-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1743+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17401744
, "module A"
17411745
, " ("
17421746
, " foo,bar) where"
17431747
, "foo = id"
17441748
, "bar = foo"])
17451749
, testSession "export list ends in comma" $ template
17461750
(T.unlines
1747-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1751+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17481752
, "module A"
17491753
, " (foo,"
17501754
, " ) where"
@@ -1753,91 +1757,91 @@ exportUnusedTests = testGroup "export unused actions"
17531757
(R 4 0 4 3)
17541758
"Export ‘bar’"
17551759
(Just $ T.unlines
1756-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1760+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17571761
, "module A"
17581762
, " (foo,"
17591763
, " bar) where"
17601764
, "foo = id"
17611765
, "bar = foo"])
17621766
, testSession "unused pattern synonym" $ template
17631767
(T.unlines
1764-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1765-
, "{-# LANGUAGE PatternSynonyms #-}"
1768+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1769+
, "{-# LANGUAGE PatternSynonyms #-}"
17661770
, "module A () where"
17671771
, "pattern Foo a <- (a, _)"])
17681772
(R 3 0 3 10)
17691773
"Export ‘Foo’"
17701774
(Just $ T.unlines
1771-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1772-
, "{-# LANGUAGE PatternSynonyms #-}"
1775+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1776+
, "{-# LANGUAGE PatternSynonyms #-}"
17731777
, "module A (pattern Foo) where"
17741778
, "pattern Foo a <- (a, _)"])
17751779
, testSession "unused data type" $ template
17761780
(T.unlines
1777-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1781+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17781782
, "module A () where"
17791783
, "data Foo = Foo"])
17801784
(R 2 0 2 7)
17811785
"Export ‘Foo’"
17821786
(Just $ T.unlines
1783-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1787+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17841788
, "module A (Foo(..)) where"
17851789
, "data Foo = Foo"])
17861790
, testSession "unused newtype" $ template
17871791
(T.unlines
1788-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1792+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17891793
, "module A () where"
17901794
, "newtype Foo = Foo ()"])
17911795
(R 2 0 2 10)
17921796
"Export ‘Foo’"
17931797
(Just $ T.unlines
1794-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1798+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
17951799
, "module A (Foo(..)) where"
17961800
, "newtype Foo = Foo ()"])
17971801
, testSession "unused type synonym" $ template
17981802
(T.unlines
1799-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1803+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18001804
, "module A () where"
18011805
, "type Foo = ()"])
18021806
(R 2 0 2 7)
18031807
"Export ‘Foo’"
18041808
(Just $ T.unlines
1805-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1809+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18061810
, "module A (Foo) where"
18071811
, "type Foo = ()"])
18081812
, testSession "unused type family" $ template
18091813
(T.unlines
1810-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1811-
, "{-# LANGUAGE TypeFamilies #-}"
1814+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1815+
, "{-# LANGUAGE TypeFamilies #-}"
18121816
, "module A () where"
18131817
, "type family Foo p"])
18141818
(R 3 0 3 15)
18151819
"Export ‘Foo’"
18161820
(Just $ T.unlines
1817-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1818-
, "{-# LANGUAGE TypeFamilies #-}"
1821+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1822+
, "{-# LANGUAGE TypeFamilies #-}"
18191823
, "module A (Foo(..)) where"
18201824
, "type family Foo p"])
18211825
, testSession "unused typeclass" $ template
18221826
(T.unlines
1823-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1827+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18241828
, "module A () where"
18251829
, "class Foo a"])
18261830
(R 2 0 2 8)
18271831
"Export ‘Foo’"
18281832
(Just $ T.unlines
1829-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1833+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18301834
, "module A (Foo(..)) where"
18311835
, "class Foo a"])
18321836
, testSession "infix" $ template
18331837
(T.unlines
1834-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1838+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18351839
, "module A () where"
18361840
, "a `f` b = ()"])
18371841
(R 2 0 2 11)
18381842
"Export ‘f’"
18391843
(Just $ T.unlines
1840-
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
1844+
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
18411845
, "module A (f) where"
18421846
, "a `f` b = ()"])
18431847
]
@@ -2260,6 +2264,7 @@ thTests =
22602264
-- | test that TH is reevaluated on typecheck
22612265
thReloadingTest :: TestTree
22622266
thReloadingTest = testCase "reloading-th-test" $ withoutStackEnv $ runWithExtraFiles "TH" $ \dir -> do
2267+
22632268
let aPath = dir </> "THA.hs"
22642269
bPath = dir </> "THB.hs"
22652270
cPath = dir </> "THC.hs"

0 commit comments

Comments
 (0)