diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 4faefa7a24..81d991db2b 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -15,9 +15,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} - {-# OPTIONS_GHC -Wno-orphans #-} -- On 9.4 we get a new redundant constraint warning, but deleting the @@ -423,7 +423,7 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context where applyAllAction verTxtDocId = - let args = Just $ toJSON (AA verTxtDocId) + let args = Just $ toJSON (ApplyHint verTxtDocId Nothing) in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionKind_QuickFix) Nothing Nothing Nothing Nothing Nothing args -- |Some hints do not have an associated refactoring @@ -435,23 +435,21 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context diags = context ^. LSP.diagnostics resolveProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_CodeActionResolve -resolveProvider recorder ideState _pluginId ca@CodeAction {_data_ = Just data_} = pluginResponse $ do - case fromJSON data_ of - (Success (AA verTxtDocId@(VersionedTextDocumentIdentifier uri _))) -> do - file <- getNormalizedFilePath uri - edit <- ExceptT $ liftIO $ applyHint recorder ideState file Nothing verTxtDocId - pure $ ca & LSP.edit ?~ edit - (Success (AO verTxtDocId@(VersionedTextDocumentIdentifier uri _) pos hintTitle)) -> do - let oneHint = OneHint pos hintTitle - file <- getNormalizedFilePath uri - edit <- ExceptT $ liftIO $ applyHint recorder ideState file (Just oneHint) verTxtDocId +resolveProvider recorder ideState _ + ca@CodeAction {_data_ = Just (fromJSON -> (Success (ApplyHint verTxtDocId oneHint)))} = pluginResponse $ do + file <- getNormalizedFilePath (verTxtDocId ^. LSP.uri) + edit <- ExceptT $ liftIO $ applyHint recorder ideState file oneHint verTxtDocId pure $ ca & LSP.edit ?~ edit - (Success (IH verTxtDocId@(VersionedTextDocumentIdentifier uri _) hintTitle )) -> do - file <- getNormalizedFilePath uri +resolveProvider recorder ideState _ + ca@CodeAction {_data_ = Just (fromJSON -> (Success (IgnoreHint verTxtDocId hintTitle)))} = pluginResponse $ do + file <- getNormalizedFilePath (verTxtDocId ^. LSP.uri) edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle pure $ ca & LSP.edit ?~ edit - Error s-> throwE ("JSON decoding error: " <> s) -resolveProvider _ _ _ _ = pluginResponse $ throwE "CodeAction with no data field" +resolveProvider _ _ _ + CodeAction {_data_ = Just (fromJSON @HlintResolveCommands -> (Error (T.pack -> str)))} = + pure $ Left $ ResponseError (InR ErrorCodes_ParseError) str Nothing +resolveProvider _ _ _ CodeAction {_data_ = _} = + pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Unexpected argument for code action resolve handler: (Probably Nothing)" Nothing -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable @@ -461,13 +459,13 @@ diagnosticToCodeActions verTxtDocId diagnostic , let isHintApplicable = "refact:" `T.isPrefixOf` code , let hint = T.replace "refact:" "" code , let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module" - , let suppressHintArguments = IH verTxtDocId hint + , let suppressHintArguments = IgnoreHint verTxtDocId hint = catMaybes -- Applying the hint is marked preferred because it addresses the underlying error. -- Disabling the rule isn't, because less often used and configuration can be adapted. [ if | isHintApplicable , let applyHintTitle = "Apply hint \"" <> hint <> "\"" - applyHintArguments = AO verTxtDocId start hint -> + applyHintArguments = ApplyHint verTxtDocId (Just $ OneHint start hint) -> Just (mkCodeAction applyHintTitle diagnostic (Just (toJSON applyHintArguments)) True) | otherwise -> Nothing , Just (mkCodeAction suppressHintTitle diagnostic (Just (toJSON suppressHintArguments)) False) @@ -525,22 +523,25 @@ ignoreHint _recorder ideState nfp verTxtDocId ignoreHintTitle = do Nothing -> pure $ Left "Unable to get fileContents" -- --------------------------------------------------------------------- -data HlintResolveCommands = AA { verTxtDocId :: VersionedTextDocumentIdentifier} - | AO { verTxtDocId :: VersionedTextDocumentIdentifier - , start_pos :: Position - -- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them. - , hintTitle :: HintTitle - } - | IH { verTxtDocId :: VersionedTextDocumentIdentifier - , ignoreHintTitle :: HintTitle - } deriving (Generic, ToJSON, FromJSON) +data HlintResolveCommands = + ApplyHint + { verTxtDocId :: VersionedTextDocumentIdentifier + -- |If Nothing, apply all hints, otherise only apply + -- the given hint + , oneHint :: Maybe OneHint + } + | IgnoreHint + { verTxtDocId :: VersionedTextDocumentIdentifier + , ignoreHintTitle :: HintTitle + } deriving (Generic, ToJSON, FromJSON) type HintTitle = T.Text -data OneHint = OneHint - { oneHintPos :: Position - , oneHintTitle :: HintTitle - } deriving (Eq, Show) +data OneHint = + OneHint + { oneHintPos :: Position + , oneHintTitle :: HintTitle + } deriving (Generic, Eq, Show, ToJSON, FromJSON) applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either String WorkspaceEdit) applyHint recorder ide nfp mhint verTxtDocId =