diff --git a/hls-refactor-plugin.cabal b/hls-refactor-plugin.cabal --- a/hls-refactor-plugin.cabal +++ b/hls-refactor-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hls-refactor-plugin -version: 2.0.0.1 +version: 2.1.0.0 synopsis: Exactprint refactorings for Haskell Language Server description: Please see the README on GitHub at @@ -68,8 +68,8 @@ , ghc-boot , regex-tdfa , text-rope - , ghcide == 2.0.0.1 - , hls-plugin-api == 2.0.0.1 + , ghcide == 2.1.0.0 + , hls-plugin-api == 2.1.0.0 , lsp , text , transformers @@ -86,6 +86,9 @@ , lens , data-default , time + -- FIXME: Only needed to workaround for qualified imports in GHC 9.4 + , regex-applicative + , parser-combinators ghc-options: -Wall -Wno-name-shadowing default-language: Haskell2010 @@ -100,7 +103,7 @@ , base , filepath , hls-refactor-plugin - , hls-test-utils == 2.0.0.1 + , hls-test-utils == 2.1.0.0 , lens , lsp-types , text diff --git a/src/Development/IDE/GHC/ExactPrint.hs b/src/Development/IDE/GHC/ExactPrint.hs --- a/src/Development/IDE/GHC/ExactPrint.hs +++ b/src/Development/IDE/GHC/ExactPrint.hs @@ -81,7 +81,7 @@ import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes import Development.IDE.Types.Location -import Development.IDE.Types.Logger (Pretty (pretty), +import Ide.Logger (Pretty (pretty), Recorder, WithPriority, cmapWithPrio) @@ -90,8 +90,7 @@ import qualified GHC.Generics as GHC import Ide.PluginUtils import Language.Haskell.GHC.ExactPrint.Parsers -import Language.LSP.Types -import Language.LSP.Types.Capabilities (ClientCapabilities) +import Language.LSP.Protocol.Types import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, @@ -210,15 +209,15 @@ transform :: DynFlags -> ClientCapabilities -> - Uri -> + VersionedTextDocumentIdentifier -> Graft (Either String) ParsedSource -> Annotated ParsedSource -> Either String WorkspaceEdit -transform dflags ccs uri f a = do +transform dflags ccs verTxtDocId f a = do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions + pure $ diffText ccs (verTxtDocId, T.pack src) (T.pack res) IncludeDeletions ------------------------------------------------------------------------------ @@ -227,16 +226,16 @@ Monad m => DynFlags -> ClientCapabilities -> - Uri -> + VersionedTextDocumentIdentifier -> Graft (ExceptStringT m) ParsedSource -> Annotated ParsedSource -> m (Either String WorkspaceEdit) -transformM dflags ccs uri f a = runExceptT $ +transformM dflags ccs verTextDocId f a = runExceptT $ runExceptString $ do let src = printA a a' <- transformA a $ runGraft f dflags let res = printA a' - pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions + pure $ diffText ccs (verTextDocId, T.pack src) (T.pack res) IncludeDeletions -- | Returns whether or not this node requires its immediate children to have diff --git a/src/Development/IDE/Plugin/CodeAction.hs b/src/Development/IDE/Plugin/CodeAction.hs --- a/src/Development/IDE/Plugin/CodeAction.hs +++ b/src/Development/IDE/Plugin/CodeAction.hs @@ -15,14 +15,16 @@ ) where import Control.Applicative ((<|>)) +import Control.Applicative.Combinators.NonEmpty (sepBy1) import Control.Arrow (second, (&&&), (>>>)) import Control.Concurrent.STM.Stats (atomically) import Control.Monad.Extra import Control.Monad.IO.Class +import Control.Monad.Trans +import Control.Monad.Trans.Except (ExceptT (ExceptT)) import Control.Monad.Trans.Maybe -import Data.Aeson import Data.Char import qualified Data.DList as DL import Data.Function @@ -65,35 +67,37 @@ import Development.IDE.Plugin.TypeLenses (suggestSignature) import Development.IDE.Types.Exports import Development.IDE.Types.Location -import Development.IDE.Types.Logger hiding - (group) import Development.IDE.Types.Options import GHC.Exts (fromList) import qualified GHC.LanguageExtensions as Lang +import Ide.Logger hiding + (group) +import qualified Text.Regex.Applicative as RE #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif -import Ide.PluginUtils (subRange) +import Ide.PluginUtils (extractTextInRange, + subRange) import Ide.Types -import qualified Language.LSP.Server as LSP -import Language.LSP.Types (ApplyWorkspaceEditParams (..), +import Language.LSP.Protocol.Message (Method (..), + SMethod (..)) +import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (..), CodeAction (..), CodeActionContext (CodeActionContext, _diagnostics), - CodeActionKind (CodeActionQuickFix), + CodeActionKind (CodeActionKind_QuickFix), CodeActionParams (CodeActionParams), Command, Diagnostic (..), - List (..), MessageType (..), - ResponseError, - SMethod (..), + Null (Null), ShowMessageParams (..), TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit, _range), UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), - type (|?) (InR), + type (|?) (InL, InR), uriToFilePath) +import qualified Language.LSP.Server as LSP import Language.LSP.VFS (VirtualFile, _file_text) import qualified Text.Fuzzy.Parallel as TFP @@ -106,8 +110,8 @@ DeltaPos (..), EpAnn (..), EpaLocation (..), - hsmodAnn, - LEpaComment) + LEpaComment, + hsmodAnn) #else import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), DeltaPos, @@ -119,13 +123,9 @@ ------------------------------------------------------------------------------------------------- -- | Generate code actions. -codeAction - :: IdeState - -> PluginId - -> CodeActionParams - -> LSP.LspM c (Either ResponseError (List (Command |? CodeAction))) -codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs}) = do - contents <- LSP.getVirtualFile $ toNormalizedUri uri +codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction +codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics= xs}) = do + contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri liftIO $ do let text = Rope.toText . (_file_text :: VirtualFile -> Rope.Rope) <$> contents mbFile = toNormalizedFilePath' <$> uriToFilePath uri @@ -134,7 +134,7 @@ let actions = caRemoveRedundantImports parsedModule text diag xs uri <> caRemoveInvalidExports parsedModule text diag xs uri - pure $ Right $ List actions + pure $ InL $ actions ------------------------------------------------------------------------------------------------- @@ -150,9 +150,10 @@ , wrap suggestNewOrExtendImportForClassMethod , wrap suggestHideShadow , wrap suggestNewImport + , wrap suggestAddRecordFieldImport ] plId - in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction } + in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler SMethod_TextDocumentCodeAction codeAction } typeSigsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ @@ -196,13 +197,13 @@ PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler extendImportHandler :: CommandFunction IdeState ExtendImport -extendImportHandler ideState edit@ExtendImport {..} = do +extendImportHandler ideState edit@ExtendImport {..} = ExceptT $ do res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do - let (_, List (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . Map.toList + let (_, (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . M.toList srcSpan = rangeToSrcSpan nfp _range - LSP.sendNotification SWindowShowMessage $ - ShowMessageParams MtInfo $ + LSP.sendNotification SMethod_WindowShowMessage $ + ShowMessageParams MessageType_Info $ "Import " <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent <> "’ from " @@ -210,8 +211,8 @@ <> " (at " <> printOutputable srcSpan <> ")" - void $ LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) - return $ Right Null + void $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) + return $ Right $ InR Null extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit) extendImportHandler' ideState ExtendImport {..} @@ -248,7 +249,7 @@ Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) - return (nfp, WorkspaceEdit {_changes=Just (GHC.Exts.fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) + return (nfp, WorkspaceEdit {_changes=Just (GHC.Exts.fromList [(doc, [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero @@ -492,14 +493,14 @@ = caRemoveCtx ++ [caRemoveAll] | otherwise = [] where - removeSingle title tedit diagnostic = mkCA title (Just CodeActionQuickFix) Nothing [diagnostic] WorkspaceEdit{..} where - _changes = Just $ Map.singleton uri $ List tedit + removeSingle title tedit diagnostic = mkCA title (Just CodeActionKind_QuickFix) Nothing [diagnostic] WorkspaceEdit{..} where + _changes = Just $ M.singleton uri tedit _documentChanges = Nothing _changeAnnotations = Nothing removeAll tedit = InR $ CodeAction{..} where - _changes = Just $ Map.singleton uri $ List tedit + _changes = Just $ M.singleton uri tedit _title = "Remove all redundant imports" - _kind = Just CodeActionQuickFix + _kind = Just CodeActionKind_QuickFix _diagnostics = Nothing _documentChanges = Nothing _edit = Just WorkspaceEdit{..} @@ -507,7 +508,7 @@ _isPreferred = Just True _command = Nothing _disabled = Nothing - _xdata = Nothing + _data_ = Nothing _changeAnnotations = Nothing caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction] @@ -536,24 +537,24 @@ removeSingle (_, _, []) = Nothing removeSingle (title, diagnostic, ranges) = Just $ InR $ CodeAction{..} where tedit = concatMap (\r -> [TextEdit r ""]) $ nubOrd ranges - _changes = Just $ Map.singleton uri $ List tedit + _changes = Just $ M.singleton uri tedit _title = title - _kind = Just CodeActionQuickFix - _diagnostics = Just $ List [diagnostic] + _kind = Just CodeActionKind_QuickFix + _diagnostics = Just [diagnostic] _documentChanges = Nothing _edit = Just WorkspaceEdit{..} _command = Nothing -- See Note [Removing imports is preferred] _isPreferred = Just True _disabled = Nothing - _xdata = Nothing + _data_ = Nothing _changeAnnotations = Nothing removeAll [] = Nothing removeAll ranges = Just $ InR $ CodeAction{..} where tedit = concatMap (\r -> [TextEdit r ""]) ranges - _changes = Just $ Map.singleton uri $ List tedit + _changes = Just $ M.singleton uri tedit _title = "Remove all redundant exports" - _kind = Just CodeActionQuickFix + _kind = Just CodeActionKind_QuickFix _diagnostics = Nothing _documentChanges = Nothing _edit = Just WorkspaceEdit{..} @@ -561,7 +562,7 @@ -- See Note [Removing imports is preferred] _isPreferred = Just True _disabled = Nothing - _xdata = Nothing + _data_ = Nothing _changeAnnotations = Nothing suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Range]) @@ -1211,6 +1212,25 @@ in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] +suggestAddRecordFieldImport :: ExportsMap -> DynFlags -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestAddRecordFieldImport exportsMap df ps fileContents Diagnostic {..} + | Just fieldName <- findMissingField _message + , Just (range, indent) <- newImportInsertRange ps fileContents + = let qis = qualifiedImportStyle df + suggestions = nubSortBy simpleCompareImportSuggestion (constructNewImportSuggestions exportsMap (Nothing, NotInScopeThing fieldName) Nothing qis) + in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions + | otherwise = [] + where + findMissingField :: T.Text -> Maybe T.Text + findMissingField t = + let + hasfieldRegex = "((.+\\.)?HasField) \"(.+)\" ([^ ]+) ([^ ]+)" + regex = "(No instance for|Could not deduce):? (\\(" <> hasfieldRegex <> "\\)|‘" <> hasfieldRegex <> "’|" <> hasfieldRegex <> ")" + match = filter (/="") <$> matchRegexUnifySpaces t regex + in case match of + Just [_, _, _, _, fieldName, _, _] -> Just fieldName + _ -> Nothing + -- | Suggests a constraint for a declaration for which a constraint is missing. suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} @@ -1454,7 +1474,7 @@ where moduleText = moduleNameText identInfo suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport df packageExportsMap ps fileContents Diagnostic{_message} +suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg @@ -1463,17 +1483,93 @@ >>= (findImportDeclByModuleName hsmodImports . T.unpack) >>= ideclAs . unLoc <&> T.pack . moduleNameString . unLoc + , -- tentative workaround for detecting qualification in GHC 9.4 + -- FIXME: We can delete this after dropping the support for GHC 9.4 + qualGHC94 <- + guard (ghcVersion == GHC94) + *> extractQualifiedModuleNameFromMissingName (extractTextInRange _range fileContents) , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" = let qis = qualifiedImportStyle df + -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped. + -- In what fllows, @missing@ is assumed to be qualified name. + -- @thingMissing@ is already as desired with GHC != 9.4. + -- In GHC 9.4, however, GHC drops a module qualifier from a qualified symbol. + -- Thus we need to explicitly concatenate qualifier explicity in GHC 9.4. + missing + | GHC94 <- ghcVersion + , isNothing (qual <|> qual') + , Just q <- qualGHC94 = + qualify q thingMissing + | otherwise = thingMissing suggestions = nubSortBy simpleCompareImportSuggestion - (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in + (constructNewImportSuggestions packageExportsMap (qual <|> qual' <|> qualGHC94, missing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where + qualify q (NotInScopeDataConstructor d) = NotInScopeDataConstructor (q <> "." <> d) + qualify q (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (q <> "." <> d) + qualify q (NotInScopeThing d) = NotInScopeThing (q <> "." <> d) + L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ _ = [] +{- | +Extracts qualifier of the symbol from the missing symbol. +Input must be either a plain qualified variable or possibly-parenthesized qualified binary operator (though no strict checking is done for symbol part). +This is only needed to alleviate the issue #3473. + +FIXME: We can delete this after dropping the support for GHC 9.4 + +>>> extractQualifiedModuleNameFromMissingName "P.lookup" +Just "P" + +>>> extractQualifiedModuleNameFromMissingName "ΣP3_'.σlookup" +Just "\931P3_'" + +>>> extractQualifiedModuleNameFromMissingName "ModuleA.Gre_ekσ.goodδ" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ.+)" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ..|.)" +Just "ModuleA.Gre_ek\963" + +>>> extractQualifiedModuleNameFromMissingName "A.B.|." +Just "A.B" +-} +extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text +extractQualifiedModuleNameFromMissingName (T.strip -> missing) + = T.pack <$> (T.unpack missing RE.=~ qualIdentP) + where + {- + NOTE: Haskell 2010 allows /unicode/ upper & lower letters + as a module name component; otoh, regex-tdfa only allows + /ASCII/ letters to be matched with @[[:upper:]]@ and/or @[[:lower:]]@. + Hence we use regex-applicative(-text) for finer-grained predicates. + + RULES (from [Section 10 of Haskell 2010 Report](https://www.haskell.org/onlinereport/haskell2010/haskellch10.html)): + modid → {conid .} conid + conid → large {small | large | digit | ' } + small → ascSmall | uniSmall | _ + ascSmall → a | b | … | z + uniSmall → any Unicode lowercase letter + large → ascLarge | uniLarge + ascLarge → A | B | … | Z + uniLarge → any uppercase or titlecase Unicode letter + -} + + qualIdentP = parensQualOpP <|> qualVarP + parensQualOpP = RE.sym '(' *> modNameP <* RE.sym '.' <* RE.anySym <* RE.few RE.anySym <* RE.sym ')' + qualVarP = modNameP <* RE.sym '.' <* RE.some RE.anySym + conIDP = RE.withMatched $ + RE.psym isUpper + *> RE.many + (RE.psym $ \c -> c == '\'' || c == '_' || isUpper c || isLower c || isDigit c) + modNameP = fmap snd $ RE.withMatched $ conIDP `sepBy1` RE.sym '.' + + constructNewImportSuggestions :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> QualifiedImportStyle -> [ImportSuggestion] constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules qis = nubOrdBy simpleCompareImportSuggestion @@ -1608,10 +1704,11 @@ epaLocationToLine :: EpaLocation -> Maybe Int #if MIN_VERSION_ghc(9,5,0) epaLocationToLine (EpaSpan sp _) + = Just . srcLocLine . realSrcSpanEnd $ sp #else epaLocationToLine (EpaSpan sp) -#endif = Just . srcLocLine . realSrcSpanEnd $ sp +#endif epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments -- 'priorComments' contains the comments right before the current EpaLocation -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and @@ -1852,16 +1949,21 @@ -- | Returns the ranges for a binding in an import declaration rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range] -rangesForBindingImport ImportDecl{ #if MIN_VERSION_ghc(9,5,0) +rangesForBindingImport ImportDecl{ ideclImportList = Just (Exactly, L _ lies) + } b = + concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies + where + b' = wrapOperatorInParens b #else +rangesForBindingImport ImportDecl{ ideclHiding = Just (False, L _ lies) -#endif } b = concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies where b' = wrapOperatorInParens b +#endif rangesForBindingImport _ _ = [] wrapOperatorInParens :: String -> String diff --git a/src/Development/IDE/Plugin/CodeAction/Args.hs b/src/Development/IDE/Plugin/CodeAction/Args.hs --- a/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -19,8 +19,8 @@ import Control.Monad.Trans.Maybe import Data.Either (fromRight, partitionEithers) -import qualified Data.HashMap.Strict as Map import Data.IORef.Extra +import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T import Development.IDE hiding @@ -36,10 +36,11 @@ import Development.IDE.Spans.LocalBindings (Bindings) import Development.IDE.Types.Exports (ExportsMap) import Development.IDE.Types.Options (IdeOptions) -import Ide.Plugin.Config (Config) +import Ide.Plugin.Error (PluginError) import Ide.Types +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types import qualified Language.LSP.Server as LSP -import Language.LSP.Types type CodeActionTitle = T.Text @@ -47,13 +48,13 @@ type GhcideCodeActionResult = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])] -type GhcideCodeAction = ExceptT ResponseError (ReaderT CodeActionArgs IO) GhcideCodeActionResult +type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCodeActionResult ------------------------------------------------------------------------------------------------- {-# ANN runGhcideCodeAction ("HLint: ignore Move guards forward" :: String) #-} -runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult -runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = List diags}) codeAction = do +runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult +runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = diags}) codeAction = do let mbFile = toNormalizedFilePath' <$> uriToFilePath uri runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key caaGhcSession <- onceIO $ runRule GhcSession @@ -90,20 +91,19 @@ mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) mkCA title kind isPreferred diags edit = - InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing Nothing + InR $ CodeAction title kind (Just $ diags) isPreferred Nothing (Just edit) Nothing Nothing mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState mkGhcideCAPlugin codeAction plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentCodeAction $ - \state _ params@(CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext {_diagnostics = List diags}) -> do - results <- runGhcideCodeAction state params codeAction + { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction $ + \state _ params@(CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext {_diagnostics = diags}) -> do + results <- lift $ runGhcideCodeAction state params codeAction pure $ - Right $ - List + InL [ mkCA title kind isPreferred diags edit | (title, kind, isPreferred, tedit) <- results, - let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing + let edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing ] } @@ -189,17 +189,17 @@ instance ToCodeAction a => ToCodeAction (Maybe a) where toCodeAction = maybe (pure []) toCodeAction -instance ToCodeAction a => ToCodeAction (Either ResponseError a) where +instance ToCodeAction a => ToCodeAction (Either PluginError a) where toCodeAction = either (\err -> ExceptT $ ReaderT $ \_ -> pure $ Left err) toCodeAction instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where - toCodeAction (title, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just CodeActionQuickFix,Nothing,) <$> toTextEdit caa te + toCodeAction (title, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just CodeActionKind_QuickFix,Nothing,) <$> toTextEdit caa te instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where toCodeAction (title, kind, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just kind,Nothing,) <$> toTextEdit caa te instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where - toCodeAction (title, isPreferred, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just CodeActionQuickFix,Just isPreferred,) <$> toTextEdit caa te + toCodeAction (title, isPreferred, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just CodeActionKind_QuickFix,Just isPreferred,) <$> toTextEdit caa te instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where toCodeAction (title, kind, isPreferred, te) = ExceptT $ ReaderT $ \caa -> Right . pure . (title,Just kind,Just isPreferred,) <$> toTextEdit caa te diff --git a/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs --- a/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -32,7 +32,7 @@ import GHC.Exts (IsList (fromList)) import GHC.Stack (HasCallStack) import Language.Haskell.GHC.ExactPrint -import Language.LSP.Types +import Language.LSP.Protocol.Types import Development.IDE.Plugin.CodeAction.Util @@ -149,7 +149,7 @@ r return $ WorkspaceEdit - { _changes = Just (fromList [(uri, List edits)]) + { _changes = Just (fromList [(uri, edits)]) , _documentChanges = Nothing , _changeAnnotations = Nothing } diff --git a/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs b/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs --- a/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs +++ b/src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs @@ -12,8 +12,8 @@ import Data.Char import Data.List -import Language.LSP.Types (Position (Position), - Range (Range, _end, _start)) +import Language.LSP.Protocol.Types (Position (Position), + Range (Range, _end, _start)) type PositionIndexed a = [(Position, a)] diff --git a/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/src/Development/IDE/Plugin/Plugins/AddArgument.hs --- a/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -7,7 +7,7 @@ #endif #if !MIN_VERSION_ghc(9,2,1) import qualified Data.Text as T -import Language.LSP.Types +import Language.LSP.Protocol.Types (TextEdit) #else import Control.Monad (join) import Control.Monad.Trans.Class (lift) @@ -32,13 +32,14 @@ noAnn) import GHC.Hs (IsUnicodeSyntax (..)) import GHC.Types.SrcLoc (generatedSrcSpan) -import Ide.PluginUtils (makeDiffTextEdit, - responseError) -import Language.Haskell.GHC.ExactPrint (TransformT(..), +import Ide.Plugin.Error (PluginError (PluginInternalError)) +import Ide.PluginUtils (makeDiffTextEdit) +import Language.Haskell.GHC.ExactPrint (TransformT (..), noAnnSrcSpanDP1, runTransformT) import Language.Haskell.GHC.ExactPrint.Transform (d1) -import Language.LSP.Types +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types #endif #if !MIN_VERSION_ghc(9,2,1) @@ -57,7 +58,7 @@ -- foo :: a -> b -> c -> d -- foo a b = \c -> ... -- In this case a new argument would have to add its type between b and c in the signature. -plugin :: ParsedModule -> Diagnostic -> Either ResponseError [(T.Text, [TextEdit])] +plugin :: ParsedModule -> Diagnostic -> Either PluginError [(T.Text, [TextEdit])] plugin parsedModule Diagnostic {_message, _range} | Just (name, typ) <- matchVariableNotInScope message = addArgumentAction parsedModule _range name typ | Just (name, typ) <- matchFoundHoleIncludeUnderscore message = addArgumentAction parsedModule _range name (Just typ) @@ -83,11 +84,11 @@ -- For example: -- insertArg "new_pat" `foo bar baz = 1` -- => (`foo bar baz new_pat = 1`, Just ("foo", 2)) -appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either ResponseError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int)) +appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either PluginError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int)) appendFinalPatToMatches name = \case (L locDecl (ValD xVal fun@FunBind{fun_matches=mg,fun_id = idFunBind})) -> do (mg', numPatsMay) <- modifyMgMatchesT' mg (pure . second Just . addArgToMatch name) Nothing combineMatchNumPats - numPats <- TransformT $ lift $ maybeToEither (responseError "Unexpected empty match group in HsDecl") numPatsMay + numPats <- TransformT $ lift $ maybeToEither (PluginInternalError "Unexpected empty match group in HsDecl") numPatsMay let decl' = L locDecl (ValD xVal fun{fun_matches=mg'}) pure (decl', Just (idFunBind, numPats)) decl -> pure (decl, Nothing) @@ -96,7 +97,7 @@ combineMatchNumPats other Nothing = pure other combineMatchNumPats (Just l) (Just r) | l == r = pure (Just l) - | otherwise = Left $ responseError "Unexpected different numbers of patterns in HsDecl MatchGroup" + | otherwise = Left $ PluginInternalError "Unexpected different numbers of patterns in HsDecl MatchGroup" -- The add argument works as follows: -- 1. Attempt to add the given name as the last pattern of the declaration that contains `range`. @@ -109,7 +110,7 @@ -- foo () = new_def -- -- TODO instead of inserting a typed hole; use GHC's suggested type from the error -addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either ResponseError [(T.Text, [TextEdit])] +addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])] addArgumentAction (ParsedModule _ moduleSrc _ _) range name _typ = do (newSource, _, _) <- runTransformT $ do (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl (makeDeltaAst moduleSrc) @@ -117,12 +118,12 @@ Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc' Nothing -> pure moduleSrc' let diff = makeDiffTextEdit (T.pack $ exactPrint moduleSrc) (T.pack $ exactPrint newSource) - pure [("Add argument ‘" <> name <> "’ to function", fromLspList diff)] + pure [("Add argument ‘" <> name <> "’ to function", diff)] where addNameAsLastArgOfMatchingDecl = modifySmallestDeclWithM spanContainsRangeOrErr addNameAsLastArg addNameAsLastArg = fmap (first (:[])) . appendFinalPatToMatches name - spanContainsRangeOrErr = maybeToEither (responseError "SrcSpan was not valid range") . (`spanContainsRange` range) + spanContainsRangeOrErr = maybeToEither (PluginInternalError "SrcSpan was not valid range") . (`spanContainsRange` range) -- Transform an LHsType into a list of arguments and return type, to make transformations easier. hsTypeToFunTypeAsList :: LHsType GhcPs -> ([(SrcSpanAnnA, XFunTy GhcPs, HsArrow GhcPs, LHsType GhcPs)], LHsType GhcPs) @@ -162,6 +163,4 @@ lsigTy' = hsTypeFromFunTypeAsList (insertArg loc args, res) in L annHsSig (HsSig xHsSig tyVarBndrs lsigTy') -fromLspList :: List a -> [a] -fromLspList (List a) = a #endif diff --git a/src/Development/IDE/Plugin/Plugins/FillHole.hs b/src/Development/IDE/Plugin/Plugins/FillHole.hs --- a/src/Development/IDE/Plugin/Plugins/FillHole.hs +++ b/src/Development/IDE/Plugin/Plugins/FillHole.hs @@ -6,7 +6,7 @@ import Data.Char import qualified Data.Text as T import Development.IDE.Plugin.Plugins.Diagnostic -import Language.LSP.Types (Diagnostic (..), +import Language.LSP.Protocol.Types (Diagnostic (..), TextEdit (TextEdit)) import Text.Regex.TDFA (MatchResult (..), (=~)) diff --git a/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs b/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs --- a/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs +++ b/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs @@ -3,8 +3,9 @@ ) where import Data.Char -import qualified Data.Text as T -import Language.LSP.Types (Diagnostic (..), TextEdit (TextEdit)) +import qualified Data.Text as T +import Language.LSP.Protocol.Types (Diagnostic (..), + TextEdit (TextEdit)) suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)] suggestFillTypeWildcard Diagnostic{_range=_range,..} diff --git a/src/Development/IDE/Plugin/Plugins/ImportUtils.hs b/src/Development/IDE/Plugin/Plugins/ImportUtils.hs --- a/src/Development/IDE/Plugin/Plugins/ImportUtils.hs +++ b/src/Development/IDE/Plugin/Plugins/ImportUtils.hs @@ -14,7 +14,7 @@ import Development.IDE.GHC.Compat import Development.IDE.Plugin.CodeAction.ExactPrint (wildCardSymbol) import Development.IDE.Types.Exports -import Language.LSP.Types (CodeActionKind (..)) +import Language.LSP.Protocol.Types (CodeActionKind (..)) -- | Possible import styles for an 'IdentInfo'. -- @@ -80,12 +80,12 @@ quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind -quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.topLevel" -quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.withParent" -quickFixImportKind' x (ImportAllConstructors _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.allConstructors" +quickFixImportKind' x (ImportTopLevel _) = CodeActionKind_Custom $ "quickfix.import." <> x <> ".list.topLevel" +quickFixImportKind' x (ImportViaParent _ _) = CodeActionKind_Custom $ "quickfix.import." <> x <> ".list.withParent" +quickFixImportKind' x (ImportAllConstructors _) = CodeActionKind_Custom $ "quickfix.import." <> x <> ".list.allConstructors" quickFixImportKind :: T.Text -> CodeActionKind -quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x +quickFixImportKind x = CodeActionKind_Custom $ "quickfix.import." <> x -- | Possible import styles for qualified imports data QualifiedImportStyle = QualifiedImportPostfix | QualifiedImportPrefix diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -33,14 +33,14 @@ import Development.IDE.Types.Location import Development.Shake (getDirectoryFilesIO) import Ide.Types -import Language.LSP.Test -import Language.LSP.Types hiding +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (length, line), SemanticTokenRelative (length), SemanticTokensEdit (_start), mkRange) -import Language.LSP.Types.Capabilities -import qualified Language.LSP.Types.Lens as L +import Language.LSP.Test import System.Directory import System.FilePath import System.Info.Extra (isMac, isWindows) @@ -87,9 +87,9 @@ initializeTests = withResource acquire release tests where - tests :: IO (ResponseMessage Initialize) -> TestTree + tests :: IO (TResponseMessage Method_Initialize) -> TestTree tests getInitializeResponse = testGroup "initialize response capabilities" - [ chk " code action" _codeActionProvider (Just $ InL True) + [ chk " code action" _codeActionProvider (Just (InR (CodeActionOptions {_workDoneProgress = Nothing, _codeActionKinds = Nothing, _resolveProvider = Just False}))) , che " execute command" _executeCommandProvider [extendImportCommandId] ] where @@ -102,20 +102,20 @@ where doTest = do ir <- getInitializeResponse - let Just ExecuteCommandOptions {_commands = List commands} = getActual $ innerCaps ir + let Just ExecuteCommandOptions {_commands = commands} = getActual $ innerCaps ir -- Check if expected exists in commands. Note that commands can arrive in different order. mapM_ (\e -> any (\o -> T.isSuffixOf e o) commands @? show (expected, show commands)) expected - acquire :: IO (ResponseMessage Initialize) + acquire :: IO (TResponseMessage Method_Initialize) acquire = run initializeResponse - release :: ResponseMessage Initialize -> IO () + release :: TResponseMessage Method_Initialize -> IO () release = const $ pure () - innerCaps :: ResponseMessage Initialize -> ServerCapabilities - innerCaps (ResponseMessage _ _ (Right (InitializeResult c _))) = c - innerCaps (ResponseMessage _ _ (Left _)) = error "Initialization error" + innerCaps :: TResponseMessage Method_Initialize -> ServerCapabilities + innerCaps (TResponseMessage _ _ (Right (InitializeResult c _))) = c + innerCaps (TResponseMessage _ _ (Left _)) = error "Initialization error" completionTests :: TestTree completionTests = @@ -277,7 +277,7 @@ modifiedCode <- skipManyTill anyMessage (getDocumentEdit docId) liftIO $ modifiedCode @?= T.unlines expected else do - expectMessages SWorkspaceApplyEdit 1 $ \edit -> + expectMessages SMethod_WorkspaceApplyEdit 1 $ \edit -> liftIO $ assertFailure $ "Expected no edit but got: " <> show edit completionNoCommandTest :: @@ -310,6 +310,7 @@ , removeImportTests , suggestImportClassMethodTests , suggestImportTests + , suggestAddRecordFieldImportTests , suggestHideShadowTests , fixConstructorImportTests , fixModuleImportTypoTests @@ -1669,10 +1670,11 @@ , test True [] "f = empty" [] "import Control.Applicative (empty)" , test True [] "f = empty" [] "import Control.Applicative" , test True [] "f = (&)" [] "import Data.Function ((&))" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True [] "f = Data.List.NonEmpty.nonEmpty" [] "import qualified Data.List.NonEmpty" + , test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE" + , test True [] "f = (NE.:|)" [] "import qualified Data.List.NonEmpty as NE" + , test True [] "f = (Data.List.NonEmpty.:|)" [] "import qualified Data.List.NonEmpty" + , test True [] "f = (B..|.)" [] "import qualified Data.Bits as B" + , test True [] "f = (Data.Bits..|.)" [] "import qualified Data.Bits" , test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)" , test True [] "f = pack" [] "import Data.Text (pack)" , test True [] "f :: Text" ["f = undefined"] "import Data.Text (Text)" @@ -1681,17 +1683,14 @@ , test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))" , test True [] "f = (.|.)" [] "import Data.Bits ((.|.))" , test True [] "f :: a ~~ b" [] "import Data.Type.Equality ((~~))" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True ["qualified Data.Text as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , ignoreForGHC94 "On GHC 9.4 the error message doesn't contain the qualified module name: https://gitlab.haskell.org/ghc/ghc/-/issues/20472" - $ test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" , "qualified Data.Functor as T" @@ -1730,6 +1729,32 @@ else liftIO $ [_title | InR CodeAction{_title} <- actions, _title == newImp ] @?= [] +suggestAddRecordFieldImportTests :: TestTree +suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields when using OverloadedRecordDot" + [ testGroup "The field is suggested when an instance resolution failure occurs" + [ ignoreFor (BrokenForGHC [GHC810, GHC90, GHC94, GHC96]) "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest + ] + ] + where + theTest = testSessionWithExtraFiles "hover" def $ \dir -> do + configureCheckProject False + let before = T.unlines $ "module A where" : ["import B (Foo)", "getFoo :: Foo -> Int", "getFoo x = x.foo"] + after = T.unlines $ "module A where" : ["import B (Foo, foo)", "getFoo :: Foo -> Int", "getFoo x = x.foo"] + cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, B]}}" + liftIO $ writeFileUTF8 (dir "hie.yaml") cradle + liftIO $ writeFileUTF8 (dir "B.hs") $ unlines ["module B where", "data Foo = Foo { foo :: Int }"] + doc <- createDoc "Test.hs" "haskell" before + waitForProgressDone + _ <- waitForDiagnostics + let defLine = fromIntegral $ 1 + 2 + range = Range (Position defLine 0) (Position defLine maxBound) + actions <- getCodeActions doc range + action <- liftIO $ pickActionWithTitle "Add foo to the import list of B" actions + executeCodeAction action + contentAfterAction <- documentContents doc + liftIO $ after @=? contentAfterAction + + suggestImportDisambiguationTests :: TestTree suggestImportDisambiguationTests = testGroup "suggest import disambiguation actions" [ testGroup "Hiding strategy works" @@ -1855,7 +1880,7 @@ auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"] withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do doc <- openDoc file "haskell" - void $ expectDiagnostics [(file, [(DsError, loc, "Ambiguous occurrence") | loc <- locs])] + void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error, loc, "Ambiguous occurrence") | loc <- locs])] actions <- getAllCodeActions doc k dir doc actions withHideFunction = withTarget ("HideFunction" <.> "hs") @@ -2309,7 +2334,7 @@ where testFor source pos expectedTitle expectedResult = do docId <- createDoc "A.hs" "haskell" source - expectDiagnostics [ ("A.hs", [(DsWarning, pos, "not used")]) ] + expectDiagnostics [ ("A.hs", [(DiagnosticSeverity_Warning, pos, "not used")]) ] (action, title) <- extractCodeAction docId "Delete" pos @@ -2333,9 +2358,9 @@ , "f = 1" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (3, 4), "Defaulting the type variable") ] + [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the type variable") ] #else - [ (DsWarning, (3, 4), "Defaulting the following constraint") ] + [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the following constraint") ] #endif "Add type annotation ‘Integer’ to ‘1’" (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" @@ -2354,9 +2379,9 @@ , " in x" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (4, 12), "Defaulting the type variable") ] + [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the type variable") ] #else - [ (DsWarning, (4, 12), "Defaulting the following constraint") ] + [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the following constraint") ] #endif "Add type annotation ‘Integer’ to ‘3’" (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" @@ -2376,9 +2401,9 @@ , " in x" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (4, 20), "Defaulting the type variable") ] + [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the type variable") ] #else - [ (DsWarning, (4, 20), "Defaulting the following constraint") ] + [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the following constraint") ] #endif "Add type annotation ‘Integer’ to ‘5’" (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" @@ -2399,12 +2424,12 @@ , "f = seq \"debug\" traceShow \"debug\"" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (6, 8), "Defaulting the type variable") - , (DsWarning, (6, 16), "Defaulting the type variable") + [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the type variable") + , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the type variable") ] #else - [ (DsWarning, (6, 8), "Defaulting the following constraint") - , (DsWarning, (6, 16), "Defaulting the following constraint") + [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the following constraint") + , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the following constraint") ] #endif ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’") @@ -2427,9 +2452,9 @@ , "f a = traceShow \"debug\" a" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (6, 6), "Defaulting the type variable") ] + [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the type variable") ] #else - [ (DsWarning, (6, 6), "Defaulting the following constraint") ] + [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the following constraint") ] #endif ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’") (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" @@ -2451,9 +2476,9 @@ , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))" ]) #if MIN_VERSION_ghc(9,4,0) - [ (DsWarning, (6, 54), "Defaulting the type variable") ] + [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the type variable") ] #else - [ (DsWarning, (6, 54), "Defaulting the following constraint") ] + [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the following constraint") ] #endif ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’") (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" diff --git a/test/Test/AddArgument.hs b/test/Test/AddArgument.hs --- a/test/Test/AddArgument.hs +++ b/test/Test/AddArgument.hs @@ -11,12 +11,12 @@ import Data.List.Extra import qualified Data.Text as T import Development.IDE.Types.Location -import Language.LSP.Test -import Language.LSP.Types hiding +import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (length, line), SemanticTokenRelative (length), SemanticTokensEdit (_start), mkRange) +import Language.LSP.Test import Test.Tasty import Test.Tasty.HUnit