From 0a6ad88a06572118ef0c253777924cf1f7aeab2d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 26 Jul 2021 17:31:27 +0100 Subject: [PATCH 01/11] Completions from exports map --- .../src/Development/IDE/Plugin/Completions.hs | 13 +++++- .../IDE/Plugin/Completions/Logic.hs | 2 +- .../IDE/Plugin/Completions/Types.hs | 40 ++++++++++++++----- 3 files changed, 42 insertions(+), 13 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 80fa95239a..995c0fca4b 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -30,7 +30,8 @@ import Development.IDE.Graph.Classes import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.Completions.Logic import Development.IDE.Plugin.Completions.Types -import Development.IDE.Types.HscEnvEq (hscEnv) +import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports), + hscEnv) import Development.IDE.Types.Location import GHC.Exts (toList) import GHC.Generics @@ -42,6 +43,9 @@ import qualified Language.LSP.VFS as VFS #if MIN_VERSION_ghc(9,0,0) import GHC.Tc.Module (tcRnImportDecls) #else +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import Development.IDE.Types.Exports import TcRnDriver (tcRnImportDecls) #endif @@ -130,7 +134,12 @@ getCompletionsLSP ide plId nonLocalCompls <- useWithStaleFast NonLocalCompletions npath pm <- useWithStaleFast GetParsedModule npath binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath - pure (opts, fmap (,pm,binds) ((fst <$> localCompls) <> (fst <$> nonLocalCompls))) + exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath + exportsMap <- mapM liftIO exportsMapIO + let exportsCompItems = foldMap (map fromIdentInfo . Set.toList) . Map.elems . getExportsMap <$> exportsMap + exportsCompls = mempty{unqualCompls = fromMaybe [] exportsCompItems} + let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> (Just exportsCompls) + pure (opts, fmap (,pm,binds) compls) case compls of Just (cci', parsedMod, bindMap) -> do pfix <- VFS.getCompletionPrefix position cnts diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 9f958f17e0..78671f9b55 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -606,7 +606,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor | "{-# " `T.isPrefixOf` fullLine -> return $ filtPragmaCompls (pragmaSuffix fullLine) | otherwise -> do - let uniqueFiltCompls = nubOrdOn insertText filtCompls + let uniqueFiltCompls = nubOrdOn (\x -> (insertText x, importedFrom x) ) filtCompls compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls return $ filtModNameCompls ++ filtKeywordCompls diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 59ed71bedc..0caebcc409 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -7,20 +7,23 @@ module Development.IDE.Plugin.Completions.Types ( ) where import Control.DeepSeq -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import SrcLoc -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) +import Data.Aeson (FromJSON, ToJSON) +import Data.Char (isUpper) +import Data.Maybe (isJust) +import Data.Text (Text) import Development.IDE.Spans.Common -import GHC.Generics (Generic) -import Ide.Plugin.Config (Config) +import Development.IDE.Types.Exports +import GHC.Generics (Generic) +import Ide.Plugin.Config (Config) import Ide.Plugin.Properties -import Ide.PluginUtils (usePropertyLsp) -import Ide.Types (PluginId) -import Language.LSP.Server (MonadLsp) -import Language.LSP.Types (CompletionItemKind, Uri) +import Ide.PluginUtils (usePropertyLsp) +import Ide.Types (PluginId) +import Language.LSP.Server (MonadLsp) +import Language.LSP.Types (CompletionItemKind (..), Uri) -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs @@ -77,6 +80,23 @@ data CompItem = CI } deriving (Eq, Show) +fromIdentInfo :: IdentInfo -> CompItem +fromIdentInfo IdentInfo{..} = CI + { compKind= + if isDatacon + then CiConstructor + else if isJust parent then CiProperty else CiFunction + , insertText=rendered + , importedFrom=Right moduleNameText + , typeText=Nothing + , label=rendered + , isInfix=Nothing + , docs=emptySpanDoc + , isTypeCompl= not isDatacon && isUpper (T.head rendered) + -- TODO Extend imports + , additionalTextEdits=Nothing + } + -- Associates a module's qualifier with its members newtype QualCompls = QualCompls { getQualCompls :: Map.Map T.Text [CompItem] } From 5b9f6e12a8fe805576f86a476598c4d7d1027c06 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 26 Jul 2021 19:55:00 +0100 Subject: [PATCH 02/11] Add new import on completion --- .../src/Development/IDE/Plugin/CodeAction.hs | 4 ++- .../src/Development/IDE/Plugin/Completions.hs | 26 ++++++++++++++----- .../IDE/Plugin/Completions/Logic.hs | 2 +- .../IDE/Plugin/Completions/Types.hs | 14 +++++++--- 4 files changed, 33 insertions(+), 13 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 9faa7ab4e4..9de13c3b0d 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -11,7 +11,9 @@ module Development.IDE.Plugin.CodeAction iePluginDescriptor, typeSigsPluginDescriptor, bindingsPluginDescriptor, - fillHolePluginDescriptor + fillHolePluginDescriptor, + newImport, + newImportToEdit -- * For testing , matchRegExMultipleImports ) where diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 995c0fca4b..d66b434400 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -23,17 +23,20 @@ import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToSrcSpan) import Development.IDE.GHC.ExactPrint (Annotated (annsA), - GetAnnotatedParsedSource (GetAnnotatedParsedSource)) + GetAnnotatedParsedSource (GetAnnotatedParsedSource), + astA) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph import Development.IDE.Graph.Classes +import Development.IDE.Plugin.CodeAction (newImport, + newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.Completions.Logic import Development.IDE.Plugin.Completions.Types import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports), hscEnv) import Development.IDE.Types.Location -import GHC.Exts (toList) +import GHC.Exts (fromList, toList) import GHC.Generics import Ide.Plugin.Config (Config) import Ide.Types @@ -136,7 +139,7 @@ getCompletionsLSP ide plId binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath exportsMap <- mapM liftIO exportsMapIO - let exportsCompItems = foldMap (map fromIdentInfo . Set.toList) . Map.elems . getExportsMap <$> exportsMap + let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap exportsCompls = mempty{unqualCompls = fromMaybe [] exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> (Just exportsCompls) pure (opts, fmap (,pm,binds) compls) @@ -194,10 +197,19 @@ extendImportHandler' ideState ExtendImport {..} let df = ms_hspp_opts msrModSummary wantedModule = mkModuleName (T.unpack importName) wantedQual = mkModuleName . T.unpack <$> importQual - imp <- liftMaybe $ find (isWantedModule wantedModule wantedQual) msrImports - fmap (nfp,) $ liftEither $ - rewriteToWEdit df doc (annsA ps) $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp + existingImport = find (isWantedModule wantedModule wantedQual) msrImports + case existingImport of + Just imp -> do + fmap (nfp,) $ liftEither $ + rewriteToWEdit df doc (annsA ps) $ + extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp + Nothing -> do + let n = newImport importName (Just it) importQual False + it = case thingParent of + Nothing -> newThing + Just p -> p <> "(" <> newThing <> ")" + t <- liftMaybe $ snd <$> newImportToEdit n (astA ps) + return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 78671f9b55..e0d8f54a68 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -606,7 +606,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor | "{-# " `T.isPrefixOf` fullLine -> return $ filtPragmaCompls (pragmaSuffix fullLine) | otherwise -> do - let uniqueFiltCompls = nubOrdOn (\x -> (insertText x, importedFrom x) ) filtCompls + let uniqueFiltCompls = nubOrdOn (\x -> (label x, importedFrom x, compKind x) ) filtCompls compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls return $ filtModNameCompls ++ filtKeywordCompls diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 0caebcc409..682218d824 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -80,8 +80,8 @@ data CompItem = CI } deriving (Eq, Show) -fromIdentInfo :: IdentInfo -> CompItem -fromIdentInfo IdentInfo{..} = CI +fromIdentInfo :: Uri -> IdentInfo -> CompItem +fromIdentInfo doc IdentInfo{..} = CI { compKind= if isDatacon then CiConstructor @@ -93,8 +93,14 @@ fromIdentInfo IdentInfo{..} = CI , isInfix=Nothing , docs=emptySpanDoc , isTypeCompl= not isDatacon && isUpper (T.head rendered) - -- TODO Extend imports - , additionalTextEdits=Nothing + , additionalTextEdits= Just $ + ExtendImport + { doc, + thingParent = parent, + importName = moduleNameText, + importQual = Nothing, + newThing = rendered + } } -- Associates a module's qualifier with its members From cef1715345558892cc8288ac4b66d01526e7c93c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 07:23:06 +0100 Subject: [PATCH 03/11] skip internal modules in exports map --- ghcide/src/Development/IDE/Types/Exports.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index b155ee9f51..30fcec0c7a 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -27,6 +27,7 @@ import GhcPlugins (IfaceExport, ModGuts (..)) import HieDb import Name import TcRnTypes (TcGblEnv (..)) +import Data.List (isSuffixOf) newtype ExportsMap = ExportsMap {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)} @@ -109,10 +110,13 @@ createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne where mn = moduleName $ tcg_mod mi +nonInternalModules :: ModuleName -> Bool +nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString + createExportsMapHieDb :: HieDb -> IO ExportsMap createExportsMapHieDb hiedb = do mods <- getAllIndexedMods hiedb - idents <- forM mods $ \m -> do + idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do let mn = modInfoName $ hieModInfo m mText = pack $ moduleNameString mn fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn @@ -126,6 +130,9 @@ createExportsMapHieDb hiedb = do p = pack . occNameString <$> exportParent unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])] -unpackAvail !(pack . moduleNameString -> mod) = map f . mkIdentInfos mod +unpackAvail mn + | nonInternalModules mn = map f . mkIdentInfos mod + | otherwise = const [] where - f id@IdentInfo {..} = (name, [id]) + !mod = pack $ moduleNameString mn + f id@IdentInfo {..} = (rendered, [id]) From 9e19e3f53f9add8e3afef621f1b8e8135b694b0a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 07:24:23 +0100 Subject: [PATCH 04/11] preserve OccNames in exports map --- ghcide/src/Development/IDE/GHC/Orphans.hs | 4 ++ .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- ghcide/src/Development/IDE/Types/Exports.hs | 43 ++++++++++--------- 3 files changed, 27 insertions(+), 22 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index ba92091be6..566e8aa0c6 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -21,6 +21,7 @@ import GHC () import GhcPlugins import Retrie.ExactPrint (Annotated) import qualified StringBuffer as SB +import Unique (getKey) -- Orphan instances for types from the GHC API. @@ -162,3 +163,6 @@ instance (NFData HsModule) where instance (NFData (HsModule a)) where #endif rnf = rwhnf + +instance Show OccName where show = prettyPrint +instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 9de13c3b0d..1fda96d75e 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -837,7 +837,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_ -- fallback to using GHC suggestion even though it is not always correct | otherwise = Just IdentInfo - { name = binding + { name = mkVarOcc $ T.unpack binding , rendered = binding , parent = Nothing , isDatacon = False diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 30fcec0c7a..b49385e88f 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -9,25 +9,26 @@ module Development.IDE.Types.Exports createExportsMapTc ,createExportsMapHieDb,size) where -import Avail (AvailInfo (..)) -import Control.DeepSeq (NFData (..)) +import Avail (AvailInfo (..)) +import Control.DeepSeq (NFData (..)) import Control.Monad -import Data.Bifunctor (Bifunctor (second)) -import Data.HashMap.Strict (HashMap, elems) -import qualified Data.HashMap.Strict as Map -import Data.HashSet (HashSet) -import qualified Data.HashSet as Set -import Data.Hashable (Hashable) -import Data.Text (Text, pack) +import Data.Bifunctor (Bifunctor (second)) +import Data.HashMap.Strict (HashMap, elems) +import qualified Data.HashMap.Strict as Map +import Data.HashSet (HashSet) +import qualified Data.HashSet as Set +import Data.Hashable (Hashable) +import Data.List (isSuffixOf) +import Data.Text (Text, pack) import Development.IDE.GHC.Compat +import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util -import FieldLabel (flSelector) -import GHC.Generics (Generic) -import GhcPlugins (IfaceExport, ModGuts (..)) +import FieldLabel (flSelector) +import GHC.Generics (Generic) +import GhcPlugins (IfaceExport, ModGuts (..)) import HieDb import Name -import TcRnTypes (TcGblEnv (..)) -import Data.List (isSuffixOf) +import TcRnTypes (TcGblEnv (..)) newtype ExportsMap = ExportsMap {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)} @@ -42,7 +43,7 @@ instance Semigroup ExportsMap where type IdentifierText = Text data IdentInfo = IdentInfo - { name :: !Text + { name :: !OccName , rendered :: Text , parent :: !(Maybe Text) , isDatacon :: !Bool @@ -73,19 +74,19 @@ renderIEWrapped n mkIdentInfos :: Text -> AvailInfo -> [IdentInfo] mkIdentInfos mod (Avail n) = - [IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod] + [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] mkIdentInfos mod (AvailTC parent (n:nn) flds) -- Following the GHC convention that parent == n if parent is exported | n == parent - = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod + = [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod | n <- nn ++ map flSelector flds ] ++ - [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod] + [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] where parentP = pack $ printName parent mkIdentInfos mod (AvailTC _ nn flds) - = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod + = [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod | n <- nn ++ map flSelector flds ] @@ -122,9 +123,9 @@ createExportsMapHieDb hiedb = do fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn return $ ExportsMap $ Map.fromListWith (<>) (concat idents) where - wrap identInfo = (name identInfo, Set.fromList [identInfo]) + wrap identInfo = (rendered identInfo, Set.fromList [identInfo]) -- unwrap :: ExportRow -> IdentInfo - unwrap m ExportRow{..} = IdentInfo n n p exportIsDatacon m + unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m where n = pack (occNameString exportName) p = pack . occNameString <$> exportParent From d6bc1854f359cd4c53119651c4a81a6913849638 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 26 Jul 2021 22:11:28 +0100 Subject: [PATCH 05/11] fix uniqueness filter --- .../IDE/Plugin/Completions/Logic.hs | 39 +++++++++++++++- .../IDE/Plugin/Completions/Types.hs | 46 ++++--------------- 2 files changed, 47 insertions(+), 38 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index e0d8f54a68..3b77953a6c 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -9,6 +9,7 @@ module Development.IDE.Plugin.Completions.Logic ( , cacheDataProducer , localCompletionsForParsedModule , getCompletions +, fromIdentInfo ) where import Control.Applicative @@ -19,6 +20,7 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Maybe (fromMaybe, isJust, + isNothing, listToMaybe, mapMaybe) import qualified Data.Text as T @@ -49,6 +51,7 @@ import Development.IDE.Plugin.Completions.Types import Development.IDE.Spans.Common import Development.IDE.Spans.Documentation import Development.IDE.Spans.LocalBindings +import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Options import GhcPlugins (flLabel, unpackFS) @@ -302,6 +305,25 @@ mkPragmaCompl label insertText = Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet) Nothing Nothing Nothing Nothing Nothing Nothing +fromIdentInfo :: Uri -> IdentInfo -> CompItem +fromIdentInfo doc IdentInfo{..} = CI + { compKind= occNameToComKind Nothing name + , insertText=rendered + , importedFrom=Right moduleNameText + , typeText=Nothing + , label=rendered + , isInfix=Nothing + , docs=emptySpanDoc + , isTypeCompl= not isDatacon && isUpper (T.head rendered) + , additionalTextEdits= Just $ + ExtendImport + { doc, + thingParent = parent, + importName = moduleNameText, + importQual = Nothing, + newThing = rendered + } + } cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do @@ -606,13 +628,26 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor | "{-# " `T.isPrefixOf` fullLine -> return $ filtPragmaCompls (pragmaSuffix fullLine) | otherwise -> do - let uniqueFiltCompls = nubOrdOn (\x -> (label x, importedFrom x, compKind x) ) filtCompls + -- assumes that nubOrdBy is stable + let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls return $ filtModNameCompls ++ filtKeywordCompls ++ map (toggleSnippets caps config) compls - +uniqueCompl :: CompItem -> CompItem -> Ordering +uniqueCompl x y = + case compare (label x, importedFrom x, compKind x) + (label y, importedFrom y, compKind y) of + EQ -> + -- preserve completions for duplicate record fields where the only difference is in the type + -- remove redundant completions with less type info + if typeText x == typeText y + || isNothing (typeText x) + || isNothing (typeText y) + then EQ + else compare (insertText x) (insertText y) + other -> other -- --------------------------------------------------------------------- -- helper functions for pragmas -- --------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 682218d824..58cd8f1c58 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -7,23 +7,20 @@ module Development.IDE.Plugin.Completions.Types ( ) where import Control.DeepSeq -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import SrcLoc -import Data.Aeson (FromJSON, ToJSON) -import Data.Char (isUpper) -import Data.Maybe (isJust) -import Data.Text (Text) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) import Development.IDE.Spans.Common -import Development.IDE.Types.Exports -import GHC.Generics (Generic) -import Ide.Plugin.Config (Config) +import GHC.Generics (Generic) +import Ide.Plugin.Config (Config) import Ide.Plugin.Properties -import Ide.PluginUtils (usePropertyLsp) -import Ide.Types (PluginId) -import Language.LSP.Server (MonadLsp) -import Language.LSP.Types (CompletionItemKind (..), Uri) +import Ide.PluginUtils (usePropertyLsp) +import Ide.Types (PluginId) +import Language.LSP.Server (MonadLsp) +import Language.LSP.Types (CompletionItemKind (..), Uri) -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs @@ -80,29 +77,6 @@ data CompItem = CI } deriving (Eq, Show) -fromIdentInfo :: Uri -> IdentInfo -> CompItem -fromIdentInfo doc IdentInfo{..} = CI - { compKind= - if isDatacon - then CiConstructor - else if isJust parent then CiProperty else CiFunction - , insertText=rendered - , importedFrom=Right moduleNameText - , typeText=Nothing - , label=rendered - , isInfix=Nothing - , docs=emptySpanDoc - , isTypeCompl= not isDatacon && isUpper (T.head rendered) - , additionalTextEdits= Just $ - ExtendImport - { doc, - thingParent = parent, - importName = moduleNameText, - importQual = Nothing, - newThing = rendered - } - } - -- Associates a module's qualifier with its members newtype QualCompls = QualCompls { getQualCompls :: Map.Map T.Text [CompItem] } From fa19f8e3f09fab74c14f8e39ced8e5d34719cdde Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 26 Jul 2021 22:11:35 +0100 Subject: [PATCH 06/11] fix tests --- ghcide/test/exe/Main.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 44358d5a5f..5e5387e415 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3979,8 +3979,9 @@ completionTest name src pos expected = testSessionWait name $ do let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls] liftIO $ do let emptyToMaybe x = if T.null x then Nothing else Just x - sortOn (Lens.view Lens._1) compls' @?= - sortOn (Lens.view Lens._1) [ (l, Just k, emptyToMaybe t, at) | (l,k,t,_,_,at) <- expected] + sortOn (Lens.view Lens._1) (take (length expected) compls') @?= + sortOn (Lens.view Lens._1) + [ (l, Just k, emptyToMaybe t, at) | (l,k,t,_,_,at) <- expected] forM_ (zip compls expected) $ \(CompletionItem{..}, (_,_,_,expectedSig, expectedDocs, _)) -> do when expectedSig $ assertBool ("Missing type signature: " <> T.unpack _label) (isJust _detail) @@ -4362,7 +4363,7 @@ otherCompletionTests = [ _ <- waitForDiagnostics compls <- getCompletions docA $ Position 2 4 let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"] - liftIO $ compls' @?= ["member ${1:Foo}", "member ${1:Bar}"], + liftIO $ take 2 compls' @?= ["member ${1:Foo}", "member ${1:Bar}"], testSessionWait "maxCompletions" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines From a12b4a42f43021ed6f7b740245f235d3c55d8bc2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 07:08:01 +0100 Subject: [PATCH 07/11] add tests --- ghcide/test/exe/Main.hs | 85 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 5e5387e415..10908adbb2 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3968,6 +3968,7 @@ completionTests [ testGroup "non local" nonLocalCompletionTests , testGroup "topLevel" topLevelCompletionTests , testGroup "local" localCompletionTests + , testGroup "global" globalCompletionTests , testGroup "other" otherCompletionTests ] @@ -4376,6 +4377,90 @@ otherCompletionTests = [ liftIO $ length compls @?= maxCompletions def ] +globalCompletionTests :: [TestTree] +globalCompletionTests = + [ testSessionWait "fromList" $ do + doc <- createDoc "A.hs" "haskell" $ T.unlines + [ "{-# OPTIONS_GHC -Wunused-binds #-}", + "module A () where", + "a = fromList" + ] + _ <- waitForDiagnostics + compls <- getCompletions doc (Position 2 12) + let compls' = + [T.drop 1 $ T.dropEnd 10 d + | CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label} + <- compls + , _label == "fromList" + ] + liftIO $ take 3 (sort compls') @?= + map ("Defined in "<>) + [ "'Data.IntMap" + , "'Data.IntMap.Lazy" + , "'Data.IntMap.Strict" + ] + + , testSessionWait "Map" $ do + doc <- createDoc "A.hs" "haskell" $ T.unlines + [ "{-# OPTIONS_GHC -Wunused-binds #-}", + "module A () where", + "a :: Map" + ] + _ <- waitForDiagnostics + compls <- getCompletions doc (Position 2 7) + let compls' = + [T.drop 1 $ T.dropEnd 10 d + | CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label} + <- compls + , _label == "Map" + ] + liftIO $ take 3 (sort compls') @?= + map ("Defined in "<>) + [ "'Data.Map" + , "'Data.Map.Lazy" + , "'Data.Map.Strict" + ] + , testSessionWait "no duplicates" $ do + doc <- createDoc "A.hs" "haskell" $ T.unlines + [ "{-# OPTIONS_GHC -Wunused-binds #-}", + "module A () where", + "import GHC.Exts(fromList)", + "a = fromList" + ] + _ <- waitForDiagnostics + compls <- getCompletions doc (Position 3 13) + let duplicate = + find + (\case + CompletionItem + { _insertText = Just "fromList" + , _documentation = + Just (CompletionDocMarkup (MarkupContent MkMarkdown d)) + } -> + "GHC.Exts" `T.isInfixOf` d + _ -> False + ) compls + liftIO $ duplicate @?= Nothing + + , testSessionWait "non-local before global" $ do + -- non local completions are more specific + doc <- createDoc "A.hs" "haskell" $ T.unlines + [ "{-# OPTIONS_GHC -Wunused-binds #-}", + "module A () where", + "import GHC.Exts(fromList)", + "a = fromList" + ] + _ <- waitForDiagnostics + compls <- getCompletions doc (Position 3 13) + let compls' = + [_insertText + | CompletionItem {_label, _insertText} <- compls + , _label == "fromList" + ] + liftIO $ take 3 compls' @?= + map Just ["fromList ${1:([Item l])}", "fromList", "fromList"] + ] + highlightTests :: TestTree highlightTests = testGroup "highlight" [ testSessionWait "value" $ do From 01225200a37a7b2ca2b3cf1541291b8071e334b6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 10:16:34 +0100 Subject: [PATCH 08/11] hlint --- ghcide/src/Development/IDE/Plugin/Completions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index d66b434400..a4d5ed489e 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -141,7 +141,7 @@ getCompletionsLSP ide plId exportsMap <- mapM liftIO exportsMapIO let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap exportsCompls = mempty{unqualCompls = fromMaybe [] exportsCompItems} - let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> (Just exportsCompls) + let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls pure (opts, fmap (,pm,binds) compls) case compls of Just (cci', parsedMod, bindMap) -> do From 0dc5ddec7eca2c87ae25587b1786aff9c3cc9b8f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 11:00:55 +0100 Subject: [PATCH 09/11] remove duplicate Orphan instance --- plugins/hls-tactics-plugin/src/Wingman/Types.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index d15893f3b1..9818967832 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -121,9 +121,6 @@ instance Ord CType where instance Show CType where show = unsafeRender . unCType -instance Show OccName where - show = unsafeRender - instance Show Name where show = unsafeRender From 3bbe9ad407c8de89c78e4cbcf9a8d3919854c312 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 11:44:01 +0100 Subject: [PATCH 10/11] attempt compat. with GHC 9.x --- ghcide/src/Development/IDE/GHC/Orphans.hs | 2 ++ ghcide/src/Development/IDE/Plugin/Completions.hs | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 566e8aa0c6..97c38b1d58 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -51,6 +51,8 @@ instance Hashable GhcPlugins.InstalledUnitId where hashWithSalt salt = hashWithSalt salt . installedUnitIdString #else instance Show InstalledUnitId where show = prettyPrint +deriving instance Ord SrcSpan +deriving instance Ord UnhelpfulSpanReason #endif instance NFData SB.StringBuffer where rnf = rwhnf diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index a4d5ed489e..b42cedacb3 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -13,6 +13,8 @@ import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Maybe import Data.Aeson +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set import Data.List (find) import Data.Maybe import qualified Data.Text as T @@ -33,6 +35,7 @@ import Development.IDE.Plugin.CodeAction (newImport, import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.Completions.Logic import Development.IDE.Plugin.Completions.Types +import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports), hscEnv) import Development.IDE.Types.Location @@ -46,9 +49,6 @@ import qualified Language.LSP.VFS as VFS #if MIN_VERSION_ghc(9,0,0) import GHC.Tc.Module (tcRnImportDecls) #else -import qualified Data.HashMap.Strict as Map -import qualified Data.HashSet as Set -import Development.IDE.Types.Exports import TcRnDriver (tcRnImportDecls) #endif From f56c61b817b58c2a73daebb3d1db080ef6b5f9b3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 27 Jul 2021 18:37:39 +0100 Subject: [PATCH 11/11] handle qualified imports --- ghcide/src/Development/IDE/Plugin/Completions.hs | 5 +++-- .../Development/IDE/Plugin/Completions/Logic.hs | 15 +++++++++------ .../Development/IDE/Plugin/Completions/Types.hs | 13 ++++++++----- ghcide/src/Development/IDE/Types/Exports.hs | 2 +- ghcide/test/exe/Main.hs | 15 +++++++++++++++ 5 files changed, 36 insertions(+), 14 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index b42cedacb3..05f0b13837 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -140,7 +140,7 @@ getCompletionsLSP ide plId exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath exportsMap <- mapM liftIO exportsMapIO let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap - exportsCompls = mempty{unqualCompls = fromMaybe [] exportsCompItems} + exportsCompls = mempty{anyQualCompls = fromMaybe [] exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls pure (opts, fmap (,pm,binds) compls) case compls of @@ -204,7 +204,8 @@ extendImportHandler' ideState ExtendImport {..} rewriteToWEdit df doc (annsA ps) $ extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp Nothing -> do - let n = newImport importName (Just it) importQual False + let n = newImport importName sym importQual False + sym = if isNothing importQual then Just it else Nothing it = case thingParent of Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 3b77953a6c..5371583955 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -305,8 +305,8 @@ mkPragmaCompl label insertText = Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet) Nothing Nothing Nothing Nothing Nothing Nothing -fromIdentInfo :: Uri -> IdentInfo -> CompItem -fromIdentInfo doc IdentInfo{..} = CI +fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem +fromIdentInfo doc IdentInfo{..} q = CI { compKind= occNameToComKind Nothing name , insertText=rendered , importedFrom=Right moduleNameText @@ -320,7 +320,7 @@ fromIdentInfo doc IdentInfo{..} = CI { doc, thingParent = parent, importName = moduleNameText, - importQual = Nothing, + importQual = q, newThing = rendered } } @@ -407,6 +407,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do { allModNamesAsNS = allModNamesAsNS , unqualCompls = unquals , qualCompls = quals + , anyQualCompls = [] , importableModules = moduleNames } @@ -416,6 +417,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod CC { allModNamesAsNS = mempty , unqualCompls = compls , qualCompls = mempty + , anyQualCompls = [] , importableModules = mempty } where @@ -529,7 +531,7 @@ getCompletions -> ClientCapabilities -> CompletionsConfig -> IO [CompletionItem] -getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules} +getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} maybe_parsed (localBindings, bmapping) prefixInfo caps config = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." @@ -588,8 +590,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor Just m -> Right $ ppr m compls = if T.null prefixModule - then localCompls ++ unqualCompls - else Map.findWithDefault [] prefixModule $ getQualCompls qualCompls + then localCompls ++ unqualCompls ++ (($Nothing) <$> anyQualCompls) + else Map.findWithDefault [] prefixModule (getQualCompls qualCompls) + ++ (($ Just prefixModule) <$> anyQualCompls) filtListWith f list = [ f label diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 58cd8f1c58..b8660887b6 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -91,18 +91,21 @@ instance Monoid QualCompls where data CachedCompletions = CC { allModNamesAsNS :: [T.Text] -- ^ All module names in scope. -- Prelude is a single module - , unqualCompls :: [CompItem] -- ^ All Possible completion items + , unqualCompls :: [CompItem] -- ^ Unqualified completion items , qualCompls :: QualCompls -- ^ Completion items associated to -- to a specific module name. + , anyQualCompls :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier , importableModules :: [T.Text] -- ^ All modules that may be imported. - } deriving Show + } + +instance Show CachedCompletions where show _ = "" instance NFData CachedCompletions where rnf = rwhnf instance Monoid CachedCompletions where - mempty = CC mempty mempty mempty mempty + mempty = CC mempty mempty mempty mempty mempty instance Semigroup CachedCompletions where - CC a b c d <> CC a' b' c' d' = - CC (a<>a') (b<>b') (c<>c') (d<>d') + CC a b c d e <> CC a' b' c' d' e' = + CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index b49385e88f..36594d2b56 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -136,4 +136,4 @@ unpackAvail mn | otherwise = const [] where !mod = pack $ moduleNameString mn - f id@IdentInfo {..} = (rendered, [id]) + f id@IdentInfo {..} = (pack (prettyPrint name), [id]) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 10908adbb2..81216debfb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4459,6 +4459,21 @@ globalCompletionTests = ] liftIO $ take 3 compls' @?= map Just ["fromList ${1:([Item l])}", "fromList", "fromList"] + , testGroup "auto import snippets" + [ completionCommandTest + "import Data.Sequence" + ["module A where", "foo :: Seq"] + (Position 1 9) + "Seq" + ["module A where", "import Data.Sequence (Seq)", "foo :: Seq"] + + , completionCommandTest + "qualified import" + ["module A where", "foo :: Seq.Seq"] + (Position 1 13) + "Seq" + ["module A where", "import qualified Data.Sequence as Seq", "foo :: Seq.Seq"] + ] ] highlightTests :: TestTree