diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 31b1f5965b..79c9a48837 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -1161,6 +1161,9 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do Just wdir -> compRoot wdir let dflags''' = setWorkingDirectory root $ +#if MIN_VERSION_ghc(9,8,0) + setNoShowErrorContext $ +#endif disableWarningsAsErrors $ -- disabled, generated directly by ghcide instead flip gopt_unset Opt_WriteInterface $ @@ -1175,6 +1178,12 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do dflags'' return (dflags''', targets) +#if MIN_VERSION_ghc(9,8,0) +setNoShowErrorContext :: DynFlags -> DynFlags +setNoShowErrorContext df = + gopt_unset df Opt_ShowErrorContext +#endif + setIgnoreInterfacePragmas :: DynFlags -> DynFlags setIgnoreInterfacePragmas df = gopt_set (gopt_set df Opt_IgnoreInterfacePragmas) Opt_IgnoreOptimChanges diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 03384aec92..993d95117a 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -27,7 +27,8 @@ module Development.IDE.GHC.Util( dontWriteHieFiles, disableWarningsAsErrors, printOutputable, - getExtensions + getExtensions, + textInRange ) where import Control.Concurrent @@ -272,3 +273,21 @@ printOutputable = getExtensions :: ParsedModule -> [Extension] getExtensions = toList . extensionFlags . ms_hspp_opts . pm_mod_summary + +-- | Returns [start .. end[ +textInRange :: Range -> T.Text -> T.Text +textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCol)) (Position (fromIntegral -> endRow) (fromIntegral -> endCol))) text = + case compare startRow endRow of + LT -> + let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine + (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of + [] -> ("", []) + firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween) + maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines + in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine) + EQ -> + let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine) + in T.take (endCol - startCol) (T.drop startCol line) + GT -> "" + where + linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index fa2a1dd46c..60b4f91b20 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-} @@ -203,7 +204,11 @@ isClassNodeIdentifier (Right i) ident | 'C':':':_ <- unpackFS $ occNameFS $ occ isClassNodeIdentifier _ _ = False isClassMethodWarning :: T.Text -> Bool +#if MIN_VERSION_ghc(9,8,0) +isClassMethodWarning = T.isPrefixOf "No explicit implementation for" +#else isClassMethodWarning = T.isPrefixOf "• No explicit implementation for" +#endif isInstanceValBind :: ContextInfo -> Bool isInstanceValBind (ValBind InstanceBind _ _) = True @@ -242,4 +247,3 @@ minDefToMethodGroups hsc gblEnv range sigs minDef = makeMethodGroup <$> go minDe go (Or ms) = concatMap (go . unLoc) ms go (And ms) = foldr (liftA2 (<>) . go . unLoc) [[]] ms go (Parens m) = go (unLoc m) - diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index a50ed3f3d8..1e173c2e1b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -52,7 +52,8 @@ import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import qualified Development.IDE.GHC.ExactPrint as E import Development.IDE.GHC.Util (printOutputable, - printRdrName) + printRdrName, + textInRange) import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed @@ -343,12 +344,13 @@ findSigOfBinds range = go findSigOfBind range (unLoc lHsBindLR) go _ = Nothing -findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p) -findInstanceHead df instanceHead decls = +findInstanceHead :: (p ~ GhcPass p0) => Range -> [LHsDecl p] -> Maybe (LHsType p) +findInstanceHead diagnosticLocation decls = listToMaybe [ hsib_body - | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls, - showSDoc df (ppr hsib_body) == instanceHead + | L (locA -> instanceLocation) (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls + , Just instanceRange <- [srcSpanToRange instanceLocation] + , (subRange diagnosticLocation instanceRange) ] #if MIN_VERSION_ghc(9,9,0) @@ -832,7 +834,15 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, | otherwise = [] where makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")" -#if MIN_VERSION_ghc(9,4,0) +#if MIN_VERSION_ghc(9,8,0) + pat multiple at _ _ = T.concat [ ".*Defaulting the type variable " + , ".*to type ‘([^ ]+)’ " + , "in the following constraint" + , if multiple then "s" else " " + , ".*arising from the literal ‘(.+)’" + , if at then ".+at ([^ ]*)" else "" + ] +#elif MIN_VERSION_ghc(9,4,0) pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable " , ".*to type ‘([^ ]+)’ " , "in the following constraint" @@ -1246,7 +1256,7 @@ suggestConstraint df ps diag@Diagnostic {..} #endif codeAction = if _message =~ ("the type signature for:" :: String) then suggestFunctionConstraint df parsedSource - else suggestInstanceConstraint df parsedSource + else suggestInstanceConstraint parsedSource in codeAction diag missingConstraint | otherwise = [] where @@ -1268,9 +1278,9 @@ suggestConstraint df ps diag@Diagnostic {..} in getCorrectGroup <$> match -- | Suggests a constraint for an instance declaration for which a constraint is missing. -suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] +suggestInstanceConstraint :: ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] -suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missingConstraint +suggestInstanceConstraint (L _ HsModule {hsmodDecls}) Diagnostic {..} missingConstraint | Just instHead <- instanceHead = [(actionTitle missingConstraint , appendConstraint (T.unpack missingConstraint) instHead)] | otherwise = [] @@ -1282,8 +1292,7 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- • In the expression: x == y -- In an equation for ‘==’: (Wrap x) == (Wrap y) = x == y -- In the instance declaration for ‘Eq (Wrap a)’ - | Just [instanceDeclaration] <- matchRegexUnifySpaces _message "In the instance declaration for ‘([^`]*)’" - , Just instHead <- findInstanceHead df (T.unpack instanceDeclaration) hsmodDecls + | Just instHead <- findInstanceHead _range hsmodDecls = Just instHead -- Suggests a constraint for an instance declaration with one or more existing constraints. -- • Could not deduce (Eq b) arising from a use of ‘==’ @@ -1939,24 +1948,6 @@ splitTextAtPosition (Position (fromIntegral -> row) (fromIntegral -> col)) x = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow) | otherwise = (x, T.empty) --- | Returns [start .. end[ -textInRange :: Range -> T.Text -> T.Text -textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCol)) (Position (fromIntegral -> endRow) (fromIntegral -> endCol))) text = - case compare startRow endRow of - LT -> - let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine - (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of - [] -> ("", []) - firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween) - maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines - in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine) - EQ -> - let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine) - in T.take (endCol - startCol) (T.drop startCol line) - GT -> "" - where - linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text) - -- | Returns the ranges for a binding in an import declaration rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range] #if MIN_VERSION_ghc(9,5,0) @@ -1991,14 +1982,18 @@ smallerRangesForBindingExport lies b = where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens $ unqualify b + #if MIN_VERSION_ghc(9,9,0) ranges' (L _ (IEThingWith _ thing _ inners _)) + | T.unpack (printOutputable thing) == b' = [] + | otherwise = + [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] #else ranges' (L _ (IEThingWith _ thing _ inners)) -#endif | T.unpack (printOutputable thing) == b' = [] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] +#endif ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs index 8016bcc305..1ea0f58acb 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs @@ -5,22 +5,26 @@ module Development.IDE.Plugin.Plugins.FillHole import Control.Monad (guard) import Data.Char import qualified Data.Text as T +import Development.IDE.GHC.Util (textInRange) import Development.IDE.Plugin.Plugins.Diagnostic import Language.LSP.Protocol.Types (Diagnostic (..), TextEdit (TextEdit)) import Text.Regex.TDFA (MatchResult (..), (=~)) -suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] -suggestFillHole Diagnostic{_range=_range,..} +suggestFillHole :: Maybe T.Text -> Diagnostic -> [(T.Text, TextEdit)] +suggestFillHole contents Diagnostic{_range=_range,..} | Just holeName <- extractHoleName _message , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) = - let isInfixHole = _message =~ addBackticks holeName :: Bool in + let isInfixHole = textInDiagnosticRange =~ addBackticks holeName :: Bool in map (proposeHoleFit holeName False isInfixHole) holeFits ++ map (proposeHoleFit holeName True isInfixHole) refFits | otherwise = [] where extractHoleName = fmap (headOrThrow "impossible") . flip matchRegexUnifySpaces "Found hole: ([^ ]*)" + textInDiagnosticRange = case contents of + Nothing -> "" + Just text -> textInRange _range text addBackticks text = "`" <> text <> "`" addParens text = "(" <> text <> ")" proposeHoleFit holeName parenthise isInfixHole name =