From dbc23a9a8cf7e31217482b0ecb99385a29d75c85 Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Sat, 6 Aug 2022 15:27:56 -0500 Subject: [PATCH 01/10] baseline for record completions --- .../src/Development/IDE/Plugin/Completions.hs | 23 +++- .../IDE/Plugin/Completions/Logic.hs | 116 +++++++++++++++--- .../IDE/Plugin/Completions/Types.hs | 23 ++++ 3 files changed, 142 insertions(+), 20 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 4a02d94bf9..b5d16a1bd6 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -48,6 +48,9 @@ import qualified Language.LSP.VFS as VFS import Numeric.Natural import Text.Fuzzy.Parallel (Scored (..)) +import qualified GHC.LanguageExtensions as LangExt +import Language.LSP.Types + data Log = LogShake Shake.Log deriving Show instance Pretty Log where @@ -120,7 +123,7 @@ getCompletionsLSP ide plId fmap Right $ case (contents, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path - (ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do + (ideOpts, compls, moduleExports, astres) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide localCompls <- useWithStaleFast LocalCompletions npath nonLocalCompls <- useWithStaleFast NonLocalCompletions npath @@ -139,19 +142,27 @@ getCompletionsLSP ide plId exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap $ exportsMap exportsCompls = mempty{anyQualCompls = exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules - - pure (opts, fmap (,pm,binds) compls, moduleExports) + + -- get HieAst if OverloadedRecordDot is enabled + let uses_th_qq (ms_hspp_opts -> dflags) = xopt LangExt.OverloadedRecordDot dflags + ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath + astres <- case ms of + Just ms' -> if uses_th_qq . msrModSummary $ ms' then useWithStaleFast GetHieAst npath else return Nothing + Nothing -> return Nothing + + pure (opts, fmap (,pm,binds) compls, moduleExports, astres) case compls of Just (cci', parsedMod, bindMap) -> do - pfix <- VFS.getCompletionPrefix position cnts + pfix <- getCompletionPrefix position cnts case (pfix, completionContext) of - (Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."}) + (Just (PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."}) -> return (InL $ List []) (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide plugins = idePlugins $ shakeExtras ide config <- getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports + + allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports pure $ InL (List $ orderedCompletions allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 6e03a61a22..750298c03c 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -10,6 +10,7 @@ module Development.IDE.Plugin.Completions.Logic ( , localCompletionsForParsedModule , getCompletions , fromIdentInfo +, getCompletionPrefix ) where import Control.Applicative @@ -20,7 +21,7 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Maybe (fromMaybe, isJust, - mapMaybe) + mapMaybe, catMaybes) import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy @@ -30,6 +31,8 @@ import Data.Either (fromRight) import Data.Function (on) import Data.Functor import qualified Data.HashMap.Strict as HM +import qualified Data.Map.Strict as M + import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) import Data.Ord (Down (Down)) @@ -67,6 +70,12 @@ import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score), original) +import Development.IDE +import Data.Coerce (coerce) + +import Data.Char (isAlphaNum) +import qualified Data.Rope.UTF16 as Rope + -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int chunkSize = 1000 @@ -564,20 +573,21 @@ getCompletions -> IdeOptions -> CachedCompletions -> Maybe (ParsedModule, PositionMapping) + -> Maybe (HieAstResult, PositionMapping) -> (Bindings, PositionMapping) - -> VFS.PosPrefixInfo + -> PosPrefixInfo -> ClientCapabilities -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) -> IO [Scored CompletionItem] getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} - maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do - let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo - enteredQual = if T.null prefixModule then "" else prefixModule <> "." + maybe_parsed maybe_ast_res (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do + let PosPrefixInfo { fullLine, prefixScope, prefixText } = prefixInfo + enteredQual = if T.null prefixScope then "" else prefixScope <> "." fullPrefix = enteredQual <> prefixText -- Boolean labels to tag suggestions as qualified (or not) - qual = not(T.null prefixModule) + qual = not(T.null prefixScope) notQual = False {- correct the position by moving 'foo :: Int -> String -> ' @@ -585,7 +595,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, to 'foo :: Int -> String -> ' ^ -} - pos = VFS.cursorPos prefixInfo + pos = cursorPos prefixInfo maxC = maxCompletions config @@ -607,6 +617,53 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, lpos = lowerRange position' hpos = upperRange position' in getCContext lpos pm <|> getCContext hpos pm + + dotFieldSelectorToCompl :: T.Text -> (Bool, CompItem) + dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing) + + -- we need the hieast to be fresh + -- not fresh, hasfield won't have a chance. it would to another larger change to ghc IfaceTyCon to contain record fields + tst :: [(Bool, CompItem)] + tst = case maybe_ast_res of + Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) (theFunc HieFresh) + _ -> [] + + getSels :: GHC.TyCon -> [T.Text] + getSels tycon = let f fieldLabel = printOutputable fieldLabel + in map f $ tyConFieldLabels tycon + + theFunc :: HieKind Type -> HieAST Type -> [(Bool, CompItem)] + theFunc kind node = concatMap g (nodeType $ nodeInfoH kind node) + where + g :: Type -> [(Bool, CompItem)] + g (TyConApp theTyCon _) = map dotFieldSelectorToCompl $ getSels theTyCon + g _ = [] + + nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a + nodeInfoH (HieFromDisk _) = nodeInfo' + nodeInfoH HieFresh = nodeInfo + + pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a] + pointCommand hf pos k = + catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast -> + -- Since GHC 9.2: + -- getAsts :: Map HiePath (HieAst a) + -- type HiePath = LexialFastString + -- + -- but before: + -- getAsts :: Map HiePath (HieAst a) + -- type HiePath = FastString + -- + -- 'coerce' here to avoid an additional function for maintaining + -- backwards compatibility. + case selectSmallestContaining (sp $ coerce fs) ast of + Nothing -> Nothing + Just ast' -> Just $ k ast' + where + sloc fs = mkRealSrcLoc fs (fromIntegral $ line+1) (fromIntegral $ cha+1) + sp fs = mkRealSrcSpan (sloc fs) (sloc fs) + line = _line pos + cha = _character pos -- completions specific to the current context ctxCompls' = case mcc of @@ -618,10 +675,10 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, ctxCompls = (fmap.fmap) (\comp -> toggleAutoExtend config $ comp { isInfix = infixCompls }) ctxCompls' infixCompls :: Maybe Backtick - infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos + infixCompls = isUsedAsInfix fullLine prefixScope prefixText pos PositionMapping bDelta = bmapping - oldPos = fromDelta bDelta $ VFS.cursorPos prefixInfo + oldPos = fromDelta bDelta $ cursorPos prefixInfo startLoc = lowerRange oldPos endLoc = upperRange oldPos localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc @@ -634,10 +691,11 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, ty = showForSnippet <$> typ thisModName = Local $ nameSrcSpan name - compls = if T.null prefixModule - then map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($Nothing) <$> anyQualCompls) - else ((qual,) <$> Map.findWithDefault [] prefixModule (getQualCompls qualCompls)) - ++ ((notQual,) . ($ Just prefixModule) <$> anyQualCompls) + compls + | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($Nothing) <$> anyQualCompls) + | not $ null tst = tst + | otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls)) + ++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls) filtListWith f list = [ fmap f label @@ -648,7 +706,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls - | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) + | T.null prefixScope = filtListWith mkExtCompl (optKeywords ideOpts) | otherwise = [] if @@ -892,3 +950,33 @@ mergeListsBy cmp all_lists = merge_lists all_lists [] -> [] [xs] -> xs lists' -> merge_lists lists' + + +getCompletionPrefix :: (Monad m) => Position -> VFS.VirtualFile -> m (Maybe PosPrefixInfo) +getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) = + return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad + let headMaybe [] = Nothing + headMaybe (x:_) = Just x + lastMaybe [] = Nothing + lastMaybe xs = Just $ last xs + + curLine <- headMaybe $ T.lines $ Rope.toText + $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext + let beforePos = T.take (fromIntegral c) curLine + curWord <- + if | T.null beforePos -> Just "" + | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc ' + | otherwise -> lastMaybe (T.words beforePos) + + let parts = T.split (=='.') + $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord + case reverse parts of + [] -> Nothing + (x:xs) -> do + let modParts = dropWhile (\_ -> False) + $ reverse $ filter (not .T.null) xs + modName = T.intercalate "." modParts + return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } + +completionPrefixPos :: PosPrefixInfo -> Position +completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1) \ No newline at end of file diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 127ba369b3..b108678378 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -26,6 +26,7 @@ import Ide.PluginUtils (getClientConfig, usePropertyLsp) import Ide.Types (PluginId) import Language.LSP.Server (MonadLsp) import Language.LSP.Types (CompletionItemKind (..), Uri) +import qualified Language.LSP.Types as J -- | Produce completions info for a file type instance RuleResult LocalCompletions = CachedCompletions @@ -136,3 +137,25 @@ instance Monoid CachedCompletions where instance Semigroup CachedCompletions where CC a b c d e <> CC a' b' c' d' e' = CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') + + +-- moved here from Language.LSP.VHS +-- | Describes the line at the current cursor position +data PosPrefixInfo = PosPrefixInfo + { fullLine :: !T.Text + -- ^ The full contents of the line the cursor is at + + , prefixScope :: !T.Text + -- ^ If any, the module name that was typed right before the cursor position. + -- For example, if the user has typed "Data.Maybe.from", then this property + -- will be "Data.Maybe" + -- If OverloadedRecordDot is enabled, "Shape.rect.width" will be + -- "Shape.rect" + + , prefixText :: !T.Text + -- ^ The word right before the cursor position, after removing the module part. + -- For example if the user has typed "Data.Maybe.from", + -- then this property will be "from" + , cursorPos :: !J.Position + -- ^ The cursor position + } deriving (Show,Eq) \ No newline at end of file From b7a70260f40c023b0b5604ceb9efdbfd5eedcec4 Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Mon, 8 Aug 2022 08:28:57 -0500 Subject: [PATCH 02/10] address feedback --- .../src/Development/IDE/Plugin/Completions.hs | 14 ++++--- .../IDE/Plugin/Completions/Logic.hs | 39 +++++++++---------- .../IDE/Plugin/Completions/Types.hs | 10 ++--- 3 files changed, 32 insertions(+), 31 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index b5d16a1bd6..343b397d2b 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -48,7 +48,7 @@ import qualified Language.LSP.VFS as VFS import Numeric.Natural import Text.Fuzzy.Parallel (Scored (..)) -import qualified GHC.LanguageExtensions as LangExt +import qualified GHC.LanguageExtensions as LangExt import Language.LSP.Types data Log = LogShake Shake.Log deriving Show @@ -142,12 +142,14 @@ getCompletionsLSP ide plId exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap $ exportsMap exportsCompls = mempty{anyQualCompls = exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules - + -- get HieAst if OverloadedRecordDot is enabled - let uses_th_qq (ms_hspp_opts -> dflags) = xopt LangExt.OverloadedRecordDot dflags + let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath - astres <- case ms of - Just ms' -> if uses_th_qq . msrModSummary $ ms' then useWithStaleFast GetHieAst npath else return Nothing + astres <- case ms of + Just ms' -> if uses_overloaded_record_dot ms' + then useWithStaleFast GetHieAst npath + else return Nothing Nothing -> return Nothing pure (opts, fmap (,pm,binds) compls, moduleExports, astres) @@ -162,7 +164,7 @@ getCompletionsLSP ide plId plugins = idePlugins $ shakeExtras ide config <- getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports + allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports pure $ InL (List $ orderedCompletions allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 750298c03c..6a2e0e0b72 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -14,14 +14,14 @@ module Development.IDE.Plugin.Completions.Logic ( ) where import Control.Applicative -import Data.Char (isUpper) +import Data.Char (isAlphaNum, isUpper) import Data.Generics import Data.List.Extra as List hiding (stripPrefix) import qualified Data.Map as Map -import Data.Maybe (fromMaybe, isJust, - mapMaybe, catMaybes) +import Data.Maybe (catMaybes, fromMaybe, + isJust, mapMaybe) import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy @@ -31,7 +31,7 @@ import Data.Either (fromRight) import Data.Function (on) import Data.Functor import qualified Data.HashMap.Strict as HM -import qualified Data.Map.Strict as M +import qualified Data.Map.Strict as M import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) @@ -70,11 +70,10 @@ import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score), original) -import Development.IDE -import Data.Coerce (coerce) +import Data.Coerce (coerce) +import Development.IDE -import Data.Char (isAlphaNum) -import qualified Data.Rope.UTF16 as Rope +import qualified Data.Rope.UTF16 as Rope -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -617,14 +616,14 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, lpos = lowerRange position' hpos = upperRange position' in getCContext lpos pm <|> getCContext hpos pm - + dotFieldSelectorToCompl :: T.Text -> (Bool, CompItem) dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing) -- we need the hieast to be fresh -- not fresh, hasfield won't have a chance. it would to another larger change to ghc IfaceTyCon to contain record fields tst :: [(Bool, CompItem)] - tst = case maybe_ast_res of + tst = case maybe_ast_res of Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) (theFunc HieFresh) _ -> [] @@ -638,7 +637,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, g :: Type -> [(Bool, CompItem)] g (TyConApp theTyCon _) = map dotFieldSelectorToCompl $ getSels theTyCon g _ = [] - + nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a nodeInfoH (HieFromDisk _) = nodeInfo' nodeInfoH HieFresh = nodeInfo @@ -692,7 +691,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, thisModName = Local $ nameSrcSpan name compls - | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($Nothing) <$> anyQualCompls) + | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($ Nothing) <$> anyQualCompls) | not $ null tst = tst | otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls)) ++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls) @@ -955,28 +954,28 @@ mergeListsBy cmp all_lists = merge_lists all_lists getCompletionPrefix :: (Monad m) => Position -> VFS.VirtualFile -> m (Maybe PosPrefixInfo) getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) = return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad - let headMaybe [] = Nothing + let headMaybe [] = Nothing headMaybe (x:_) = Just x - lastMaybe [] = Nothing - lastMaybe xs = Just $ last xs + lastMaybe [] = Nothing + lastMaybe [x] = Just x + lastMaybe (_:xs) = lastMaybe xs curLine <- headMaybe $ T.lines $ Rope.toText $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext let beforePos = T.take (fromIntegral c) curLine curWord <- - if | T.null beforePos -> Just "" + if | T.null beforePos -> Just "" | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc ' - | otherwise -> lastMaybe (T.words beforePos) + | otherwise -> lastMaybe (T.words beforePos) let parts = T.split (=='.') $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord case reverse parts of [] -> Nothing (x:xs) -> do - let modParts = dropWhile (\_ -> False) - $ reverse $ filter (not .T.null) xs + let modParts = reverse $ filter (not .T.null) xs modName = T.intercalate "." modParts return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } completionPrefixPos :: PosPrefixInfo -> Position -completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1) \ No newline at end of file +completionPrefixPos PosPrefixInfo { cursorPos = Position ln co, prefixText = str} = Position ln (co - (fromInteger . toInteger . T.length $ str) - 1) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index b108678378..a57cdf2de4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -139,10 +139,10 @@ instance Semigroup CachedCompletions where CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') --- moved here from Language.LSP.VHS +-- moved here from Language.LSP.VFS -- | Describes the line at the current cursor position data PosPrefixInfo = PosPrefixInfo - { fullLine :: !T.Text + { fullLine :: !T.Text -- ^ The full contents of the line the cursor is at , prefixScope :: !T.Text @@ -152,10 +152,10 @@ data PosPrefixInfo = PosPrefixInfo -- If OverloadedRecordDot is enabled, "Shape.rect.width" will be -- "Shape.rect" - , prefixText :: !T.Text + , prefixText :: !T.Text -- ^ The word right before the cursor position, after removing the module part. -- For example if the user has typed "Data.Maybe.from", -- then this property will be "from" - , cursorPos :: !J.Position + , cursorPos :: !J.Position -- ^ The cursor position - } deriving (Show,Eq) \ No newline at end of file + } deriving (Show,Eq) From 744bfa8d4e663e3d483a3e1cdfbc5ca76ee5cb8a Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Thu, 11 Aug 2022 08:03:02 -0500 Subject: [PATCH 03/10] gate ghc version --- ghcide/src/Development/IDE/Plugin/Completions.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 343b397d2b..d619b4567f 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -144,7 +144,11 @@ getCompletionsLSP ide plId let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules -- get HieAst if OverloadedRecordDot is enabled +#if MIN_VERSION_ghc(9,2,0) let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags +#else + let uses_overloaded_record_dot _ = False +#endif ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath astres <- case ms of Just ms' -> if uses_overloaded_record_dot ms' From b9aa8b48bc66a18e168cec23321a415fea4d6c59 Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Thu, 11 Aug 2022 08:57:47 -0500 Subject: [PATCH 04/10] add test --- test/functional/Completion.hs | 16 ++++++++++++ test/testdata/completion/RecordDotSyntax.hs | 27 +++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 test/testdata/completion/RecordDotSyntax.hs diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 820f25ce95..1844c80f0a 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -84,6 +84,22 @@ tests = testGroup "completions" [ compls <- getCompletions doc (Position 5 7) liftIO $ assertBool "Expected completions" $ not $ null compls + , testGroup "recorddotsyntax" + [ testCase "shows field selectors" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "RecordDotSyntax.hs" "haskell" + + let te = TextEdit (Range (Position 25 0) (Position 25 5)) "z = x.a" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 25 6) + item <- getCompletionByLabel "a" compls + liftIO $ do + item ^. label @?= "a" + --item ^. detail @?= Just "Data.List" TODO + --item ^. kind @?= Just CiModule + liftIO $ length compls @?= 6 + ] + -- See https://github.com/haskell/haskell-ide-engine/issues/903 , testCase "strips compiler generated stuff from completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "DupRecFields.hs" "haskell" diff --git a/test/testdata/completion/RecordDotSyntax.hs b/test/testdata/completion/RecordDotSyntax.hs new file mode 100644 index 0000000000..9bc15f91de --- /dev/null +++ b/test/testdata/completion/RecordDotSyntax.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} + +module Test where + +import qualified Data.Maybe as M + +data MyRecord = MyRecord1 + { a :: String + , b :: Integer + , c :: MyChild + } + | MyRecord2 { a2 :: String + , b2 :: Integer + , c2 :: MyChild + } deriving (Eq, Show) + +newtype MyChild = MyChild + { z :: String + } deriving (Eq, Show) + +x = MyRecord1 { a = "Hello", b = 12, c = MyChild { z = "there" } } + +y = x.a ++ show x.b + + From ee93014d9527801d89bbce18cdfaabd768ddbbf1 Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Fri, 12 Aug 2022 08:06:55 -0500 Subject: [PATCH 05/10] refactor --- .../IDE/Plugin/Completions/Logic.hs | 66 +++++++------------ 1 file changed, 24 insertions(+), 42 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 6a2e0e0b72..a6573a0762 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -31,7 +31,6 @@ import Data.Either (fromRight) import Data.Function (on) import Data.Functor import qualified Data.HashMap.Strict as HM -import qualified Data.Map.Strict as M import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) @@ -70,10 +69,10 @@ import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score), original) -import Data.Coerce (coerce) import Development.IDE import qualified Data.Rope.UTF16 as Rope +import Development.IDE.Spans.AtPoint (pointCommand) -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -617,52 +616,35 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, hpos = upperRange position' in getCContext lpos pm <|> getCContext hpos pm - dotFieldSelectorToCompl :: T.Text -> (Bool, CompItem) - dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing) -- we need the hieast to be fresh -- not fresh, hasfield won't have a chance. it would to another larger change to ghc IfaceTyCon to contain record fields - tst :: [(Bool, CompItem)] - tst = case maybe_ast_res of - Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) (theFunc HieFresh) + recordDotSyntaxCompls :: [(Bool, CompItem)] + recordDotSyntaxCompls = case maybe_ast_res of + Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) nodeCompletions _ -> [] - - getSels :: GHC.TyCon -> [T.Text] - getSels tycon = let f fieldLabel = printOutputable fieldLabel - in map f $ tyConFieldLabels tycon - - theFunc :: HieKind Type -> HieAST Type -> [(Bool, CompItem)] - theFunc kind node = concatMap g (nodeType $ nodeInfoH kind node) where + nodeCompletions :: HieAST Type -> [(Bool, CompItem)] + nodeCompletions node = concatMap g (nodeType $ nodeInfo node) g :: Type -> [(Bool, CompItem)] - g (TyConApp theTyCon _) = map dotFieldSelectorToCompl $ getSels theTyCon + g (TyConApp theTyCon _) = map (dotFieldSelectorToCompl (printOutputable $ GHC.tyConName theTyCon)) $ getSels theTyCon g _ = [] - - nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a - nodeInfoH (HieFromDisk _) = nodeInfo' - nodeInfoH HieFresh = nodeInfo - - pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a] - pointCommand hf pos k = - catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast -> - -- Since GHC 9.2: - -- getAsts :: Map HiePath (HieAst a) - -- type HiePath = LexialFastString - -- - -- but before: - -- getAsts :: Map HiePath (HieAst a) - -- type HiePath = FastString - -- - -- 'coerce' here to avoid an additional function for maintaining - -- backwards compatibility. - case selectSmallestContaining (sp $ coerce fs) ast of - Nothing -> Nothing - Just ast' -> Just $ k ast' - where - sloc fs = mkRealSrcLoc fs (fromIntegral $ line+1) (fromIntegral $ cha+1) - sp fs = mkRealSrcSpan (sloc fs) (sloc fs) - line = _line pos - cha = _character pos + getSels :: GHC.TyCon -> [T.Text] + getSels tycon = let f fieldLabel = printOutputable fieldLabel + in map f $ tyConFieldLabels tycon + dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem) + --dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing) + dotFieldSelectorToCompl recname label = (True, CI + { compKind = CiField + , insertText = label + , provenance = DefinedIn recname + , typeText = Nothing + , label = label + , isInfix = Nothing + , docs = emptySpanDoc + , isTypeCompl = False + , additionalTextEdits = Nothing + }) -- completions specific to the current context ctxCompls' = case mcc of @@ -692,7 +674,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, compls | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($ Nothing) <$> anyQualCompls) - | not $ null tst = tst + | not $ null recordDotSyntaxCompls = recordDotSyntaxCompls | otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls)) ++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls) From a2449b8e4ce7a165971b3c7fe1d03c7bf07f368b Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Wed, 31 Aug 2022 13:44:00 -0400 Subject: [PATCH 06/10] fix rope import --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index a6573a0762..fcc3425198 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -69,9 +69,9 @@ import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score), original) +import qualified Data.Text.Utf16.Rope as Rope import Development.IDE -import qualified Data.Rope.UTF16 as Rope import Development.IDE.Spans.AtPoint (pointCommand) -- Chunk size used for parallelizing fuzzy matching From 25069b849088499d1c5d30786f56d882b59adf63 Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Thu, 1 Sep 2022 09:07:41 -0400 Subject: [PATCH 07/10] fix plugins from rebase --- ghcide/src/Development/IDE/Plugin/Completions.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index d619b4567f..568a7e2951 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -48,7 +48,7 @@ import qualified Language.LSP.VFS as VFS import Numeric.Natural import Text.Fuzzy.Parallel (Scored (..)) -import qualified GHC.LanguageExtensions as LangExt +import qualified GHC.LanguageExtensions as LangExt import Language.LSP.Types data Log = LogShake Shake.Log deriving Show @@ -167,8 +167,8 @@ getCompletionsLSP ide plId let clientCaps = clientCapabilities $ shakeExtras ide plugins = idePlugins $ shakeExtras ide config <- getCompletionsConfig plId - - allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports + + allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports pure $ InL (List $ orderedCompletions allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) From bc45ebd6daace212528f7fde6c7378885795beaa Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Thu, 1 Sep 2022 09:54:29 -0400 Subject: [PATCH 08/10] gate test by ghc version --- test/functional/Completion.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 1844c80f0a..9fb45c40a2 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -84,7 +84,8 @@ tests = testGroup "completions" [ compls <- getCompletions doc (Position 5 7) liftIO $ assertBool "Expected completions" $ not $ null compls - , testGroup "recorddotsyntax" + , expectFailIfBeforeGhc92 "record dot syntax is introduced in GHC 9.2" + $ testGroup "recorddotsyntax" [ testCase "shows field selectors" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "RecordDotSyntax.hs" "haskell" @@ -364,3 +365,6 @@ shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion compls `shouldNotContainCompl` lbl = all ((/= lbl) . (^. label)) compls @? "Should not contain completion: " ++ show lbl + +expectFailIfBeforeGhc92 :: String -> TestTree -> TestTree +expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC810, GHC88, GHC86] From cccbb9f446266af96efa631ac5e6dc9ef2c1159e Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Sun, 25 Sep 2022 09:21:38 -0400 Subject: [PATCH 09/10] comments, fixes --- .../src/Development/IDE/Plugin/Completions.hs | 15 ++++---- .../IDE/Plugin/Completions/Logic.hs | 36 +++++++++++-------- .../IDE/Plugin/Completions/Types.hs | 1 - test/functional/Completion.hs | 15 ++++++-- test/testdata/completion/RecordDotSyntax.hs | 1 + 5 files changed, 42 insertions(+), 26 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 568a7e2951..a7fea1a075 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -151,24 +151,23 @@ getCompletionsLSP ide plId #endif ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath astres <- case ms of - Just ms' -> if uses_overloaded_record_dot ms' - then useWithStaleFast GetHieAst npath - else return Nothing - Nothing -> return Nothing + Just ms' | uses_overloaded_record_dot ms' + -> useWithStaleFast GetHieAst npath + _ -> return Nothing pure (opts, fmap (,pm,binds) compls, moduleExports, astres) case compls of Just (cci', parsedMod, bindMap) -> do - pfix <- getCompletionPrefix position cnts + let pfix = getCompletionPrefix position cnts case (pfix, completionContext) of - (Just (PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."}) + ((PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."}) -> return (InL $ List []) - (Just pfix', _) -> do + (_, _) -> do let clientCaps = clientCapabilities $ shakeExtras ide plugins = idePlugins $ shakeExtras ide config <- getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix' clientCaps config moduleExports + allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports pure $ InL (List $ orderedCompletions allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index fcc3425198..cb58422de4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -21,7 +21,7 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe, - isJust, mapMaybe) + isJust, mapMaybe, listToMaybe) import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy @@ -617,8 +617,10 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, in getCContext lpos pm <|> getCContext hpos pm - -- we need the hieast to be fresh - -- not fresh, hasfield won't have a chance. it would to another larger change to ghc IfaceTyCon to contain record fields + -- We need the hieast to be "fresh". We can't get types from "stale" hie files, so hasfield won't work, + -- since it gets the record fields from the types. + -- Perhaps this could be fixed with a refactor to GHC's IfaceTyCon, to have it also contain record fields. + -- Requiring fresh hieast is fine for normal workflows, because it is generated while the user edits. recordDotSyntaxCompls :: [(Bool, CompItem)] recordDotSyntaxCompls = case maybe_ast_res of Just (HAR {hieAst = hieast, hieKind = HieFresh},_) -> concat $ pointCommand hieast (completionPrefixPos prefixInfo) nodeCompletions @@ -632,8 +634,12 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, getSels :: GHC.TyCon -> [T.Text] getSels tycon = let f fieldLabel = printOutputable fieldLabel in map f $ tyConFieldLabels tycon + -- Completions can return more information that just the completion itself, but it will + -- require more than what GHC currently gives us in the HieAST, since it only gives the Type + -- of the fields, not where they are defined, etc. So for now the extra fields remain empty. + -- Also: additionalTextEdits is a todo, since we may want to import the record. It requires a way + -- to get the record's module, which isn't included in the type information used to get the fields. dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem) - --dotFieldSelectorToCompl label = (True, CI CiVariable label (ImportedFrom T.empty) Nothing label Nothing emptySpanDoc False Nothing) dotFieldSelectorToCompl recname label = (True, CI { compKind = CiField , insertText = label @@ -672,11 +678,14 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, ty = showForSnippet <$> typ thisModName = Local $ nameSrcSpan name + -- When record-dot-syntax completions are available, we return them exclusively. + -- They are only available when we write i.e. `myrecord.` with OverloadedRecordDot enabled. + -- Anything that isn't a field is invalid, so those completion don't make sense. compls - | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ ((notQual,) . ($ Nothing) <$> anyQualCompls) + | T.null prefixScope = map (notQual,) localCompls ++ map (qual,) unqualCompls ++ map (\compl -> (notQual, compl Nothing)) anyQualCompls | not $ null recordDotSyntaxCompls = recordDotSyntaxCompls | otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls)) - ++ ((notQual,) . ($ Just prefixScope) <$> anyQualCompls) + ++ map (\compl -> (notQual, compl (Just prefixScope))) anyQualCompls filtListWith f list = [ fmap f label @@ -932,19 +941,18 @@ mergeListsBy cmp all_lists = merge_lists all_lists [xs] -> xs lists' -> merge_lists lists' - -getCompletionPrefix :: (Monad m) => Position -> VFS.VirtualFile -> m (Maybe PosPrefixInfo) +-- |From the given cursor position, gets the prefix module or record for autocompletion +getCompletionPrefix :: Position -> VFS.VirtualFile -> PosPrefixInfo getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) = - return $ Just $ fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad - let headMaybe [] = Nothing - headMaybe (x:_) = Just x - lastMaybe [] = Nothing - lastMaybe [x] = Just x - lastMaybe (_:xs) = lastMaybe xs + fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad + let headMaybe = listToMaybe + lastMaybe = headMaybe . reverse + -- grab the entire line the cursor is at curLine <- headMaybe $ T.lines $ Rope.toText $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext let beforePos = T.take (fromIntegral c) curLine + -- the word getting typed, after previous space and before cursor curWord <- if | T.null beforePos -> Just "" | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc ' diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index a57cdf2de4..46129e78ad 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -139,7 +139,6 @@ instance Semigroup CachedCompletions where CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') --- moved here from Language.LSP.VFS -- | Describes the line at the current cursor position data PosPrefixInfo = PosPrefixInfo { fullLine :: !T.Text diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 9fb45c40a2..1476488a5a 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -94,11 +94,20 @@ tests = testGroup "completions" [ compls <- getCompletions doc (Position 25 6) item <- getCompletionByLabel "a" compls + liftIO $ do item ^. label @?= "a" - --item ^. detail @?= Just "Data.List" TODO - --item ^. kind @?= Just CiModule - liftIO $ length compls @?= 6 + , testCase "shows field selectors for nested field" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "RecordDotSyntax.hs" "haskell" + + let te = TextEdit (Range (Position 27 0) (Position 27 8)) "z2 = x.c.z" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 27 9) + item <- getCompletionByLabel "z" compls + + liftIO $ do + item ^. label @?= "z" ] -- See https://github.com/haskell/haskell-ide-engine/issues/903 diff --git a/test/testdata/completion/RecordDotSyntax.hs b/test/testdata/completion/RecordDotSyntax.hs index 9bc15f91de..4ea2f6994b 100644 --- a/test/testdata/completion/RecordDotSyntax.hs +++ b/test/testdata/completion/RecordDotSyntax.hs @@ -24,4 +24,5 @@ x = MyRecord1 { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b +y2 = x.c.z From 60776943d04029a61b40d966203b57a01053713e Mon Sep 17 00:00:00 2001 From: Colten Webb Date: Sun, 25 Sep 2022 15:53:51 -0400 Subject: [PATCH 10/10] fix ghc90 test --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 8 +++++--- test/functional/Completion.hs | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index cb58422de4..78a921bec4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -21,7 +21,8 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe, - isJust, mapMaybe, listToMaybe) + isJust, listToMaybe, + mapMaybe) import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy @@ -637,7 +638,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, -- Completions can return more information that just the completion itself, but it will -- require more than what GHC currently gives us in the HieAST, since it only gives the Type -- of the fields, not where they are defined, etc. So for now the extra fields remain empty. - -- Also: additionalTextEdits is a todo, since we may want to import the record. It requires a way + -- Also: additionalTextEdits is a todo, since we may want to import the record. It requires a way -- to get the record's module, which isn't included in the type information used to get the fields. dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem) dotFieldSelectorToCompl recname label = (True, CI @@ -678,7 +679,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, ty = showForSnippet <$> typ thisModName = Local $ nameSrcSpan name - -- When record-dot-syntax completions are available, we return them exclusively. + -- When record-dot-syntax completions are available, we return them exclusively. -- They are only available when we write i.e. `myrecord.` with OverloadedRecordDot enabled. -- Anything that isn't a field is invalid, so those completion don't make sense. compls @@ -744,6 +745,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, + uniqueCompl :: CompItem -> CompItem -> Ordering uniqueCompl candidate unique = case compare (label candidate, compKind candidate) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 1476488a5a..8516051c51 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -376,4 +376,4 @@ compls `shouldNotContainCompl` lbl = @? "Should not contain completion: " ++ show lbl expectFailIfBeforeGhc92 :: String -> TestTree -> TestTree -expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC810, GHC88, GHC86] +expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC810, GHC88, GHC86, GHC90]