mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Suggestions for missing imports from local modules (#739)
* Suggestions for missing imports from local modules * Avoid unnecessary work on InitialLoad when checkProject is off
This commit is contained in:
parent
f8889c7112
commit
09aa8e5f4b
@ -139,6 +139,7 @@ library
|
||||
Development.IDE.LSP.Server
|
||||
Development.IDE.Spans.Common
|
||||
Development.IDE.Types.Diagnostics
|
||||
Development.IDE.Types.Exports
|
||||
Development.IDE.Types.Location
|
||||
Development.IDE.Types.Logger
|
||||
Development.IDE.Types.Options
|
||||
|
@ -38,6 +38,7 @@ import Development.IDE.Core.RuleTypes
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.Session.VersionCheck
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Types.Options
|
||||
@ -300,10 +301,14 @@ loadSession dir = do
|
||||
-- files in the project so that `knownFiles` can learn about them and
|
||||
-- we can generate a complete module graph
|
||||
liftIO $ modifyVar_ knownFilesVar $ traverseHashed $ pure . HashSet.union (HashSet.fromList cfps')
|
||||
mmt <- uses GetModificationTime cfps'
|
||||
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
|
||||
when checkProject $
|
||||
void $ uses GetModIface cs_exist
|
||||
when checkProject $ do
|
||||
mmt <- uses GetModificationTime cfps'
|
||||
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
|
||||
modIfaces <- uses GetModIface cs_exist
|
||||
-- update xports map
|
||||
extras <- getShakeExtras
|
||||
let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
|
||||
liftIO $ modifyVar_ (exportsMap extras) $ return . (exportsMap' <>)
|
||||
pure opts
|
||||
|
||||
-- | Run the specific cradle on a specific FilePath via hie-bios.
|
||||
|
@ -26,11 +26,13 @@ import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import Development.Shake
|
||||
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Logger
|
||||
import Development.IDE.Core.RuleTypes
|
||||
import Development.IDE.Core.Shake
|
||||
import Control.Monad
|
||||
import Data.Maybe (mapMaybe)
|
||||
import GhcPlugins (HomeModInfo(hm_iface))
|
||||
|
||||
newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))
|
||||
instance IsIdeGlobal OfInterestVar
|
||||
@ -88,5 +90,12 @@ kick = mkDelayedAction "kick" Debug $ do
|
||||
files <- getFilesOfInterest
|
||||
ShakeExtras{progressUpdate} <- getShakeExtras
|
||||
liftIO $ progressUpdate KickStarted
|
||||
void $ uses TypeCheck $ HashSet.toList files
|
||||
|
||||
-- Update the exports map for the project
|
||||
results <- uses TypeCheck $ HashSet.toList files
|
||||
ShakeExtras{exportsMap} <- getShakeExtras
|
||||
let modIfaces = mapMaybe (fmap (hm_iface . tmrModInfo)) results
|
||||
!exportsMap' = createExportsMap modIfaces
|
||||
liftIO $ modifyVar_ exportsMap $ return . (exportsMap' <>)
|
||||
|
||||
liftIO $ progressUpdate KickCompleted
|
||||
|
@ -87,6 +87,7 @@ import qualified Development.IDE.Types.Logger as Logger
|
||||
import Language.Haskell.LSP.Diagnostics
|
||||
import qualified Data.SortedList as SL
|
||||
import Development.IDE.Types.Diagnostics
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Options
|
||||
import Control.Concurrent.Async
|
||||
@ -153,6 +154,8 @@ data ShakeExtras = ShakeExtras
|
||||
,restartShakeSession :: [DelayedAction ()] -> IO ()
|
||||
,ideNc :: IORef NameCache
|
||||
,knownFilesVar :: Var (Hashed (HSet.HashSet NormalizedFilePath))
|
||||
-- | A mapping of exported identifiers for local modules. Updated on kick
|
||||
,exportsMap :: Var ExportsMap
|
||||
}
|
||||
|
||||
type WithProgressFunc = forall a.
|
||||
@ -411,6 +414,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
|
||||
progressAsync <- async $
|
||||
when reportProgress $
|
||||
progressThread mostRecentProgressEvent inProgress
|
||||
exportsMap <- newVar HMap.empty
|
||||
|
||||
pure (ShakeExtras{..}, cancel progressAsync)
|
||||
(shakeDbM, shakeClose) <-
|
||||
|
@ -30,6 +30,7 @@ import Development.IDE.LSP.Server
|
||||
import Development.IDE.Plugin.CodeAction.PositionIndexed
|
||||
import Development.IDE.Plugin.CodeAction.RuleTypes
|
||||
import Development.IDE.Plugin.CodeAction.Rules
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Options
|
||||
import Development.Shake (Rules)
|
||||
@ -58,6 +59,7 @@ import Data.Functor
|
||||
import Control.Applicative ((<|>))
|
||||
import Safe (atMay)
|
||||
import Bag (isEmptyBag)
|
||||
import Control.Concurrent.Extra (readVar)
|
||||
|
||||
plugin :: Plugin c
|
||||
plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
|
||||
@ -83,10 +85,12 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
|
||||
<*> use GhcSession `traverse` mbFile
|
||||
-- This is quite expensive 0.6-0.7s on GHC
|
||||
pkgExports <- runAction "CodeAction:PackageExports" state $ (useNoFile_ . PackageExports) `traverse` env
|
||||
localExports <- readVar (exportsMap $ shakeExtras state)
|
||||
let exportsMap = Map.unionWith (<>) localExports (fromMaybe mempty pkgExports)
|
||||
let dflags = hsc_dflags . hscEnv <$> env
|
||||
pure $ Right
|
||||
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
|
||||
| x <- xs, (title, tedit) <- suggestAction dflags (fromMaybe mempty pkgExports) ideOptions ( join parsedModule ) text x
|
||||
| x <- xs, (title, tedit) <- suggestAction dflags exportsMap ideOptions ( join parsedModule ) text x
|
||||
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
|
||||
]
|
||||
|
||||
@ -132,7 +136,7 @@ executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
|
||||
|
||||
suggestAction
|
||||
:: Maybe DynFlags
|
||||
-> PackageExportsMap
|
||||
-> ExportsMap
|
||||
-> IdeOptions
|
||||
-> Maybe ParsedModule
|
||||
-> Maybe T.Text
|
||||
@ -815,7 +819,7 @@ removeRedundantConstraints mContents Diagnostic{..}
|
||||
|
||||
-------------------------------------------------------------------------------------------------
|
||||
|
||||
suggestNewImport :: PackageExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
|
||||
suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
|
||||
suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
|
||||
| msg <- unifySpaces _message
|
||||
, Just name <- extractNotInScopeName msg
|
||||
@ -835,7 +839,7 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule
|
||||
suggestNewImport _ _ _ = []
|
||||
|
||||
constructNewImportSuggestions
|
||||
:: PackageExportsMap -> NotInScope -> Maybe [T.Text] -> [T.Text]
|
||||
:: ExportsMap -> NotInScope -> Maybe [T.Text] -> [T.Text]
|
||||
constructNewImportSuggestions exportsMap thingMissing notTheseModules = nubOrd
|
||||
[ suggestion
|
||||
| (identInfo, m) <- fromMaybe [] $ Map.lookup name exportsMap
|
||||
|
@ -1,57 +1,20 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Development.IDE.Plugin.CodeAction.RuleTypes
|
||||
(PackageExports(..), PackageExportsMap
|
||||
(PackageExports(..)
|
||||
,IdentInfo(..)
|
||||
,mkIdentInfos
|
||||
) where
|
||||
|
||||
import Avail (AvailInfo(..))
|
||||
import Data.Hashable (Hashable)
|
||||
import Control.DeepSeq (NFData)
|
||||
import Data.Binary (Binary)
|
||||
import Data.Text (pack, Text)
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.Shake (RuleResult)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
import Name
|
||||
import FieldLabel (flSelector)
|
||||
|
||||
type Identifier = Text
|
||||
type ModuleName = Text
|
||||
|
||||
data IdentInfo = IdentInfo
|
||||
{ name :: !Identifier
|
||||
, rendered :: Text
|
||||
, parent :: !(Maybe Text)
|
||||
, isDatacon :: !Bool
|
||||
}
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
instance NFData IdentInfo
|
||||
|
||||
mkIdentInfos :: AvailInfo -> [IdentInfo]
|
||||
mkIdentInfos (Avail n) =
|
||||
[IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n)]
|
||||
mkIdentInfos (AvailTC parent (n:nn) flds)
|
||||
-- Following the GHC convention that parent == n if parent is exported
|
||||
| n == parent
|
||||
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) True
|
||||
| n <- nn ++ map flSelector flds
|
||||
] ++
|
||||
[ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing False]
|
||||
where
|
||||
parentP = pack $ prettyPrint parent
|
||||
|
||||
mkIdentInfos (AvailTC _ nn flds)
|
||||
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing True
|
||||
| n <- nn ++ map flSelector flds
|
||||
]
|
||||
|
||||
-- Rule type for caching Package Exports
|
||||
type instance RuleResult PackageExports = PackageExportsMap
|
||||
type PackageExportsMap = HashMap Identifier [(IdentInfo,ModuleName)]
|
||||
type instance RuleResult PackageExports = ExportsMap
|
||||
|
||||
newtype PackageExports = PackageExports HscEnvEq
|
||||
deriving (Eq, Show, Typeable, Generic)
|
||||
|
@ -3,26 +3,17 @@ module Development.IDE.Plugin.CodeAction.Rules
|
||||
)
|
||||
where
|
||||
|
||||
import Data.HashMap.Strict ( fromListWith )
|
||||
import Data.Text ( Text
|
||||
, pack
|
||||
)
|
||||
import Data.Traversable ( forM )
|
||||
import Development.IDE.Core.Rules
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.Plugin.CodeAction.RuleTypes
|
||||
import Development.IDE.Types.Exports
|
||||
import Development.Shake
|
||||
import GHC ( DynFlags(pkgState) )
|
||||
import HscTypes ( IfaceExport
|
||||
, hsc_dflags
|
||||
, mi_exports
|
||||
)
|
||||
import HscTypes ( hsc_dflags)
|
||||
import LoadIface
|
||||
import Maybes
|
||||
import Module ( Module(..)
|
||||
, ModuleName
|
||||
, moduleNameString
|
||||
)
|
||||
import Module ( Module(..) )
|
||||
import Packages ( explicitPackages
|
||||
, exposedModules
|
||||
, packageConfigId
|
||||
@ -43,19 +34,12 @@ rulePackageExports = defineNoFile $ \(PackageExports session) -> do
|
||||
, (mn, _) <- exposedModules pkg
|
||||
]
|
||||
|
||||
results <- forM targets $ \(pkg, mn) -> do
|
||||
modIfaces <- forM targets $ \(pkg, mn) -> do
|
||||
modIface <- liftIO $ initIfaceLoad env $ loadInterface
|
||||
""
|
||||
(Module (packageConfigId pkg) mn)
|
||||
(ImportByUser False)
|
||||
case modIface of
|
||||
Failed _err -> return mempty
|
||||
Succeeded mi -> do
|
||||
let avails = mi_exports mi
|
||||
return $ concatMap (unpackAvail mn) avails
|
||||
return $ fromListWith (++) $ concat results
|
||||
|
||||
unpackAvail :: ModuleName -> IfaceExport -> [(Text, [(IdentInfo, Text)])]
|
||||
unpackAvail mod =
|
||||
map (\id@IdentInfo {..} -> (name, [(id, pack $ moduleNameString mod)]))
|
||||
. mkIdentInfos
|
||||
return $ case modIface of
|
||||
Failed _err -> Nothing
|
||||
Succeeded mi -> Just mi
|
||||
return $ createExportsMap (catMaybes modIfaces)
|
||||
|
63
src/Development/IDE/Types/Exports.hs
Normal file
63
src/Development/IDE/Types/Exports.hs
Normal file
@ -0,0 +1,63 @@
|
||||
module Development.IDE.Types.Exports
|
||||
(
|
||||
IdentInfo(..),
|
||||
ExportsMap,
|
||||
createExportsMap,
|
||||
) where
|
||||
|
||||
import Avail (AvailInfo(..))
|
||||
import Control.DeepSeq (NFData)
|
||||
import Data.Text (pack, Text)
|
||||
import Development.IDE.GHC.Compat
|
||||
import Development.IDE.GHC.Util
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import GHC.Generics (Generic)
|
||||
import Name
|
||||
import FieldLabel (flSelector)
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import GhcPlugins (IfaceExport)
|
||||
|
||||
type ExportsMap = HashMap IdentifierText [(IdentInfo,ModuleNameText)]
|
||||
|
||||
type IdentifierText = Text
|
||||
type ModuleNameText = Text
|
||||
|
||||
data IdentInfo = IdentInfo
|
||||
{ name :: !Text
|
||||
, rendered :: Text
|
||||
, parent :: !(Maybe Text)
|
||||
, isDatacon :: !Bool
|
||||
}
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
instance NFData IdentInfo
|
||||
|
||||
mkIdentInfos :: AvailInfo -> [IdentInfo]
|
||||
mkIdentInfos (Avail n) =
|
||||
[IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n)]
|
||||
mkIdentInfos (AvailTC parent (n:nn) flds)
|
||||
-- Following the GHC convention that parent == n if parent is exported
|
||||
| n == parent
|
||||
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) True
|
||||
| n <- nn ++ map flSelector flds
|
||||
] ++
|
||||
[ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing False]
|
||||
where
|
||||
parentP = pack $ prettyPrint parent
|
||||
|
||||
mkIdentInfos (AvailTC _ nn flds)
|
||||
= [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing True
|
||||
| n <- nn ++ map flSelector flds
|
||||
]
|
||||
|
||||
createExportsMap :: [ModIface] -> ExportsMap
|
||||
createExportsMap = Map.fromListWith (++) . concatMap doOne
|
||||
where
|
||||
doOne mi = concatMap (unpackAvail mn) (mi_exports mi)
|
||||
where
|
||||
mn = moduleName $ mi_module mi
|
||||
|
||||
unpackAvail :: ModuleName -> IfaceExport -> [(Text, [(IdentInfo, Text)])]
|
||||
unpackAvail mod =
|
||||
map (\id@IdentInfo {..} -> (name, [(id, pack $ moduleNameString mod)]))
|
||||
. mkIdentInfos
|
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{- HLINT ignore -}
|
||||
module Testing ( module Testing ) where
|
||||
module GotoHover ( module GotoHover) where
|
||||
import Data.Text (Text, pack)
|
||||
import Foo (Bar, foo)
|
||||
|
||||
|
@ -1036,7 +1036,10 @@ suggestImportTests = testGroup "suggest import actions"
|
||||
, test False [] "f = quickCheck" [] "import Test.QuickCheck (quickCheck)"
|
||||
]
|
||||
, testGroup "want suggestion"
|
||||
[ test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
|
||||
[ test True [] "f = foo" [] "import Foo (foo)"
|
||||
, test True [] "f = Bar" [] "import Bar (Bar(Bar))"
|
||||
, test True [] "f :: Bar" [] "import Bar (Bar)"
|
||||
, test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
|
||||
, test True [] "f = (:|)" [] "import Data.List.NonEmpty (NonEmpty((:|)))"
|
||||
, test True [] "f :: Natural" ["f = undefined"] "import Numeric.Natural (Natural)"
|
||||
, test True [] "f :: Natural" ["f = undefined"] "import Numeric.Natural"
|
||||
@ -1063,12 +1066,13 @@ suggestImportTests = testGroup "suggest import actions"
|
||||
]
|
||||
]
|
||||
where
|
||||
test wanted imps def other newImp = testSession' (T.unpack def) $ \dir -> do
|
||||
test wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do
|
||||
let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
|
||||
after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
|
||||
cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -]}}"
|
||||
cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, GotoHover]}}"
|
||||
liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
|
||||
doc <- createDoc "Test.hs" "haskell" before
|
||||
void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
|
||||
_diags <- waitForDiagnostics
|
||||
let defLine = length imps + 1
|
||||
range = Range (Position defLine 0) (Position defLine maxBound)
|
||||
@ -2380,6 +2384,7 @@ thTests =
|
||||
-- | test that TH is reevaluated on typecheck
|
||||
thReloadingTest :: TestTree
|
||||
thReloadingTest = testCase "reloading-th-test" $ withoutStackEnv $ runWithExtraFiles "TH" $ \dir -> do
|
||||
|
||||
let aPath = dir </> "THA.hs"
|
||||
bPath = dir </> "THB.hs"
|
||||
cPath = dir </> "THC.hs"
|
||||
|
Loading…
Reference in New Issue
Block a user