Skip to content

Add action for ignoring HLint hint for a single definition #4670

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Add action for ignoring HLint hint for a single definition #4670

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions ghcide/src/Development/IDE/LSP/Outline.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@

module Development.IDE.LSP.Outline
( moduleOutline
, documentSymbolForDecl
)
where

Expand Down Expand Up @@ -259,5 +260,3 @@ hsConDeclsBinders cons
get_flds :: Located [LConDeclField GhcPs]
-> [LFieldOcc GhcPs]
get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds)


73 changes: 56 additions & 17 deletions plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,11 +38,11 @@ import Data.Aeson.Types (FromJSON (.
import qualified Data.ByteString as BS
import Data.Hashable
import qualified Data.HashMap.Strict as Map
import Data.List (find)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Text.Utf16.Rope.Mixed (Rope)
import qualified Data.Text.Utf16.Rope.Mixed as Rope
import Data.Typeable
import Development.IDE hiding
Expand All @@ -65,16 +65,29 @@ import System.Environment (setEnv,

import Development.IDE.GHC.Compat (DynFlags,
extensionFlags,
getLoc,
hsmodDecls,
ms_hspp_opts,
topDir)
pattern RealSrcLoc,
pattern UnhelpfulLoc,
pm_parsed_source,
srcLocLine,
srcSpanStart,
topDir,
unLoc)
import qualified Development.IDE.GHC.Compat.Util as EnumSet

#if MIN_GHC_API_VERSION(9,4,0)
import qualified GHC.Data.Strict as Strict
#endif
#if MIN_GHC_API_VERSION(9,0,0)
import GHC.Types.SrcLoc hiding
(RealSrcSpan)
(RealSrcSpan,
SrcLoc (..),
getLoc,
srcLocLine,
srcSpanStart,
unLoc)
import qualified GHC.Types.SrcLoc as GHC
#else
import qualified SrcLoc as GHC
Expand Down Expand Up @@ -111,6 +124,7 @@ import qualified Language.LSP.Protocol.Types as LSP

import Development.IDE.Core.PluginUtils as PluginUtils
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.LSP.Outline (documentSymbolForDecl)
import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits),
NextPragmaInfo (NextPragmaInfo),
getNextPragmaInfo,
Expand Down Expand Up @@ -413,8 +427,8 @@ resolveProvider recorder ideState _plId ca uri resolveValue = do
(ApplyHint verTxtDocId oneHint) -> do
edit <- ExceptT $ liftIO $ applyHint recorder ideState file oneHint verTxtDocId
pure $ ca & LSP.edit ?~ edit
(IgnoreHint verTxtDocId hintTitle ) -> do
edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle
(IgnoreHint verTxtDocId hintTitle scope) -> do
edit <- ExceptT $ liftIO $ ignoreHint scope recorder ideState file verTxtDocId hintTitle
pure $ ca & LSP.edit ?~ edit

applyRefactAvailable :: Bool
Expand All @@ -431,7 +445,7 @@ diagnosticToCodeActions verTxtDocId diagnostic
| LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic
, let isHintApplicable = "refact:" `T.isPrefixOf` code && applyRefactAvailable
, let hint = T.replace "refact:" "" code
, let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module"
, let suppressHintTitle s = "Ignore hint \"" <> hint <> "\" in this " <> s
, let suppressHintArguments = IgnoreHint verTxtDocId hint
= catMaybes
-- Applying the hint is marked preferred because it addresses the underlying error.
Expand All @@ -441,7 +455,8 @@ diagnosticToCodeActions verTxtDocId diagnostic
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)
, Just (mkCodeAction (suppressHintTitle "module") diagnostic (Just (toJSON $ suppressHintArguments IgnoreInModule)) False)
, Just (mkCodeAction (suppressHintTitle "definition") diagnostic (Just (toJSON $ suppressHintArguments $ IgnoreInDefinition start)) False)
]
| otherwise = []

Expand All @@ -458,27 +473,45 @@ mkCodeAction title diagnostic data_ isPreferred =
, _data_ = data_
}

mkSuppressHintTextEdits :: DynFlags -> Rope -> T.Text -> [LSP.TextEdit]
mkSuppressHintTextEdits dynFlags fileContents hint =
mkSuppressHintTextEdits :: Int -> T.Text -> Maybe LineSplitTextEdits -> Maybe T.Text -> [LSP.TextEdit]
mkSuppressHintTextEdits line hint lineSplitTextEdits defName =
let
NextPragmaInfo{ nextPragmaLine, lineSplitTextEdits } = getNextPragmaInfo dynFlags (Just fileContents)
nextPragmaLinePosition = Position (fromIntegral nextPragmaLine) 0
nextPragmaRange = Range nextPragmaLinePosition nextPragmaLinePosition
textEdit = LSP.TextEdit nextPragmaRange $ "{- HLINT ignore \"" <> hint <> "\" -}\n"
pos = Position (fromIntegral line) 0
range = Range pos pos
textEdit = LSP.TextEdit range $ "{- HLINT ignore " <> foldMap (<> " ") defName <> "\"" <> hint <> "\" -}\n"
lineSplitTextEditList = maybe [] (\LineSplitTextEdits{..} -> [lineSplitInsertTextEdit, lineSplitDeleteTextEdit]) lineSplitTextEdits
in
textEdit : lineSplitTextEditList
-- ---------------------------------------------------------------------

ignoreHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> VersionedTextDocumentIdentifier -> HintTitle -> IO (Either PluginError WorkspaceEdit)
ignoreHint _recorder ideState nfp verTxtDocId ignoreHintTitle = runExceptT $ do
ignoreHint :: IgnoreHintScope -> Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> VersionedTextDocumentIdentifier -> HintTitle -> IO (Either PluginError WorkspaceEdit)
ignoreHint scope _recorder ideState nfp verTxtDocId ignoreHintTitle = runExceptT $ do
(_, fileContents) <- runActionE "Hlint.GetFileContents" ideState $ useE GetFileContents nfp
(msr, _) <- runActionE "Hlint.GetModSummaryWithoutTimestamps" ideState $ useWithStaleE GetModSummaryWithoutTimestamps nfp
case fileContents of
Just contents -> do
let dynFlags = ms_hspp_opts $ msrModSummary msr
textEdits = mkSuppressHintTextEdits dynFlags contents ignoreHintTitle
workspaceEdit =
textEdits <- case scope of
IgnoreInModule ->
let NextPragmaInfo{nextPragmaLine, lineSplitTextEdits} = getNextPragmaInfo dynFlags (Just contents)
in pure $ mkSuppressHintTextEdits nextPragmaLine ignoreHintTitle lineSplitTextEdits Nothing
IgnoreInDefinition pos -> do
(pm, _) <- runActionE "Hlint.GetParsedModule" ideState $ useWithStaleE GetParsedModule nfp
let defInfo = do
containingDecl <- find (maybe False (positionInRange pos) . srcSpanToRange . getLoc)
$ hsmodDecls $ unLoc $ pm_parsed_source pm
defStartLine <- case srcSpanStart $ getLoc containingDecl of
-- TODO `srcLocLine` can apparently raise an error, but it's not clear what the safe version is
Copy link
Collaborator Author

@georgefst georgefst Jul 22, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I need to look in to this...

RealSrcLoc sl _ -> Just (srcLocLine sl - 1)
UnhelpfulLoc _ -> Nothing
-- TODO `documentSymbolForDecl` wasn't intended to be exported, and computes more than we need
-- (although laziness should save us there)
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@fendor Do you know a better way to go LHsDecl GhcPs -> Maybe Text?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Otherwise we can factor out the required part of documentSymbolForDecl, and use it there and here.

defName <- (^. LSP.name) <$> documentSymbolForDecl containingDecl
pure (defStartLine, defName)
case defInfo of
Nothing -> throwError $ PluginInternalError "bad things happened" -- TODO better error handling
Just (defStartLine, defName) -> pure $ mkSuppressHintTextEdits defStartLine ignoreHintTitle Nothing (Just defName)
let workspaceEdit =
LSP.WorkspaceEdit
(Just (M.singleton (verTxtDocId ^. LSP.uri) textEdits))
Nothing
Expand All @@ -497,6 +530,7 @@ data HlintResolveCommands =
| IgnoreHint
{ verTxtDocId :: VersionedTextDocumentIdentifier
, ignoreHintTitle :: HintTitle
, scope :: IgnoreHintScope
} deriving (Generic, ToJSON, FromJSON)

type HintTitle = T.Text
Expand All @@ -507,6 +541,11 @@ data OneHint =
, oneHintTitle :: HintTitle
} deriving (Generic, Eq, Show, ToJSON, FromJSON)

data IgnoreHintScope
= IgnoreInModule
| IgnoreInDefinition Position
deriving (Generic, ToJSON, FromJSON)

applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit)
#if !APPLY_REFACT
applyHint _ _ _ _ _ =
Expand Down
Loading