Fix issue: HLS HLint plugin doesn't preserve HLint's severities #3881 (#3902)

* Fix issue:  HLS HLint plugin doesn't preserve HLint's severities #3881

preserve severity from HLint

* Fix tests

* Only preserve error serverity from hlint

* Add comment explaining the propogation of error level serverity

---------

Co-authored-by: Michael Peyton Jones <[email protected]>

Author: IAmPara0x

Diff for: 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)]