diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 0c47287183..a5527a027b 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -125,8 +125,7 @@ import Ide.Plugin.Resolve import Ide.PluginUtils import Ide.Types hiding (Config) -import Language.Haskell.HLint as Hlint hiding - (Error) +import Language.Haskell.HLint as Hlint import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types hiding @@ -242,25 +241,40 @@ rules recorder plugin = do diagnostics :: NormalizedFilePath -> Either ParseError [Idea] -> [FileDiagnostic] diagnostics file (Right ideas) = - [(file, ShowDiag, ideaToDiagnostic i) | i <- ideas, ideaSeverity i /= Ignore] + (file, ShowDiag,) <$> catMaybes [ideaToDiagnostic i | i <- ideas] diagnostics file (Left parseErr) = [(file, ShowDiag, parseErrorToDiagnostic parseErr)] - ideaToDiagnostic :: Idea -> Diagnostic - ideaToDiagnostic idea = - LSP.Diagnostic { - _range = srcSpanToRange $ ideaSpan idea - , _severity = Just LSP.DiagnosticSeverity_Information - -- we are encoding the fact that idea has refactorings in diagnostic code - , _code = Just (InR $ T.pack $ codePre ++ ideaHint idea) - , _source = Just "hlint" - , _message = idea2Message idea - , _relatedInformation = Nothing - , _tags = Nothing - , _codeDescription = Nothing - , _data_ = Nothing - } - where codePre = if null $ ideaRefactoring idea then "" else "refact:" + + ideaToDiagnostic :: Idea -> Maybe Diagnostic + ideaToDiagnostic idea = do + diagnosticSeverity <- ideaSeverityToDiagnosticSeverity (ideaSeverity idea) + pure $ + LSP.Diagnostic { + _range = srcSpanToRange $ ideaSpan idea + , _severity = Just diagnosticSeverity + -- we are encoding the fact that idea has refactorings in diagnostic code + , _code = Just (InR $ T.pack $ codePre ++ ideaHint idea) + , _source = Just "hlint" + , _message = idea2Message idea + , _relatedInformation = Nothing + , _tags = Nothing + , _codeDescription = Nothing + , _data_ = Nothing + } + + where + codePre = if null $ ideaRefactoring idea then "" else "refact:" + + -- We only propogate error severity of hlint and downgrade other severities to Info. + -- Currently, there are just 2 error level serverities present in hlint by default: https://github.com/ndmitchell/hlint/issues/1549#issuecomment-1892701824. + -- And according to ndmitchell: The default error level severities of the two hints are justified and it's fairly uncommon to happen. + -- GH Issue about discussion on this: https://github.com/ndmitchell/hlint/issues/1549 + ideaSeverityToDiagnosticSeverity :: Hlint.Severity -> Maybe LSP.DiagnosticSeverity + ideaSeverityToDiagnosticSeverity Hlint.Ignore = Nothing + ideaSeverityToDiagnosticSeverity Hlint.Suggestion = Just LSP.DiagnosticSeverity_Information + ideaSeverityToDiagnosticSeverity Hlint.Warning = Just LSP.DiagnosticSeverity_Information + ideaSeverityToDiagnosticSeverity Hlint.Error = Just LSP.DiagnosticSeverity_Error idea2Message :: Idea -> T.Text idea2Message idea = T.unlines $ [T.pack $ ideaHint idea, "Found:", " " <> T.pack (ideaFrom idea)]