hls-refactor-plugin 2.0.0.1 → 2.1.0.0
raw patch · 12 files changed
+271/−142 lines, 12 filesdep +regex-applicativedep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependencies added: regex-applicative
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
- Development.IDE.GHC.ExactPrint: transform :: DynFlags -> ClientCapabilities -> Uri -> Graft (Either String) ParsedSource -> Annotated ParsedSource -> Either String WorkspaceEdit
+ Development.IDE.GHC.ExactPrint: transform :: DynFlags -> ClientCapabilities -> VersionedTextDocumentIdentifier -> Graft (Either String) ParsedSource -> Annotated ParsedSource -> Either String WorkspaceEdit
- Development.IDE.GHC.ExactPrint: transformM :: Monad m => DynFlags -> ClientCapabilities -> Uri -> Graft (ExceptStringT m) ParsedSource -> Annotated ParsedSource -> m (Either String WorkspaceEdit)
+ Development.IDE.GHC.ExactPrint: transformM :: Monad m => DynFlags -> ClientCapabilities -> VersionedTextDocumentIdentifier -> Graft (ExceptStringT m) ParsedSource -> Annotated ParsedSource -> m (Either String WorkspaceEdit)
Files
- hls-refactor-plugin.cabal +7/−4
- src/Development/IDE/GHC/ExactPrint.hs +8/−9
- src/Development/IDE/Plugin/CodeAction.hs +148/−46
- src/Development/IDE/Plugin/CodeAction/Args.hs +16/−16
- src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +2/−2
- src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs +2/−2
- src/Development/IDE/Plugin/Plugins/AddArgument.hs +13/−14
- src/Development/IDE/Plugin/Plugins/FillHole.hs +1/−1
- src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs +3/−2
- src/Development/IDE/Plugin/Plugins/ImportUtils.hs +5/−5
- test/Main.hs +64/−39
- test/Test/AddArgument.hs +2/−2
hls-refactor-plugin.cabal view
@@ -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 <https://github.com/haskell/haskell-language-server#readme>@@ -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
src/Development/IDE/GHC/ExactPrint.hs view
@@ -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
src/Development/IDE/Plugin/CodeAction.hs view
@@ -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
src/Development/IDE/Plugin/CodeAction/Args.hs view
@@ -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
src/Development/IDE/Plugin/CodeAction/ExactPrint.hs view
@@ -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 }
src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs view
@@ -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)]
src/Development/IDE/Plugin/Plugins/AddArgument.hs view
@@ -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
src/Development/IDE/Plugin/Plugins/FillHole.hs view
@@ -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 (..), (=~))
src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs view
@@ -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,..}
src/Development/IDE/Plugin/Plugins/ImportUtils.hs view
@@ -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
test/Main.hs view
@@ -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 #-}"
test/Test/AddArgument.hs view
@@ -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