Fix plugins where necessary for new diagnostic structure

Author: dylan-thinnes

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Diagnostics.hs

@@ -11,9 +11,11 @@ module Ide.Plugin.Cabal.Diagnostics
 )
 where
 
+import           Control.Lens                ((.~), (&))
 import qualified Data.Text                   as T
 import           Development.IDE             (FileDiagnostic,
                                               ShowDiagnostic (ShowDiag))
+import           Development.IDE.Types.Diagnostics (fdLspDiagnosticL, ideErrorWithSource)
 import           Distribution.Fields         (showPError, showPWarning)
 import qualified Distribution.Parsec         as Syntax
 import           Ide.PluginUtils             (extendNextLine)
@@ -23,6 +25,7 @@ import           Language.LSP.Protocol.Types (Diagnostic (..),
                                               Position (Position),
                                               Range (Range),
                                               fromNormalizedFilePath)
+import           Language.LSP.Protocol.Lens   (range)
 
 -- | Produce a diagnostic for a fatal Cabal parser error.
 fatalParseErrorDiagnostic :: NormalizedFilePath -> T.Text -> FileDiagnostic
@@ -80,15 +83,11 @@ mkDiag
   -> T.Text
   -- ^ The message displayed by the editor
   -> FileDiagnostic
-mkDiag file diagSource sev loc msg = (file, ShowDiag,)
-    Diagnostic
-    { _range    = loc
-    , _severity = Just sev
-    , _source   = Just diagSource
-    , _message  = msg
-    , _code     = Nothing
-    , _tags     = Nothing
-    , _relatedInformation = Nothing
-    , _codeDescription = Nothing
-    , _data_ = Nothing
-    }
+mkDiag file diagSource sev loc msg =
+  ideErrorWithSource
+    (Just diagSource)
+    (Just sev)
+    file
+    msg
+    Nothing
+    & fdLspDiagnosticL . range .~ loc

plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

@@ -211,9 +211,9 @@ rules recorder plugin = do
 
       diagnostics :: NormalizedFilePath -> Either ParseError [Idea] -> [FileDiagnostic]
       diagnostics file (Right ideas) =
-       (file, ShowDiag,) <$> catMaybes [ideaToDiagnostic i | i <- ideas]
+        [ideErrorFromLspDiag diag file Nothing | i <- ideas, Just diag <- [ideaToDiagnostic i]]
       diagnostics file (Left parseErr) =
-        [(file, ShowDiag, parseErrorToDiagnostic parseErr)]
+        [ideErrorFromLspDiag (parseErrorToDiagnostic parseErr) file Nothing]
 
 
       ideaToDiagnostic :: Idea -> Maybe Diagnostic
@@ -371,9 +371,11 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context
       allDiagnostics <- atomically $ getDiagnostics ideState
 
       let numHintsInDoc = length
-            [diagnostic | (diagnosticNormalizedFilePath, _, diagnostic) <- allDiagnostics
-                        , validCommand diagnostic
-                        , diagnosticNormalizedFilePath == docNormalizedFilePath
+            [lspDiagnostic
+            | diag <- allDiagnostics
+            , let lspDiagnostic = fdLspDiagnostic diag
+            , validCommand lspDiagnostic
+            , fdFilePath diag == docNormalizedFilePath
             ]
       let numHintsInContext = length
             [diagnostic | diagnostic <- diags

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -68,6 +68,7 @@ import           Development.IDE.Plugin.TypeLenses                 (suggestSigna
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
+import           Development.IDE.Types.Diagnostics
 import           GHC                                               (AddEpAnn (AddEpAnn),
                                                                     AnnsModule (am_main),
                                                                     DeltaPos (..),
@@ -125,7 +126,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) =
   contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getUriContents" state $ getUriContents $ toNormalizedUri uri
   liftIO $ do
     let mbFile = toNormalizedFilePath' <$> uriToFilePath uri
-    allDiags <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
+    allDiags <- atomically $ fmap fdLspDiagnostic . filter (\d -> mbFile == Just (fdFilePath d)) <$> getDiagnostics state
     (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile
     let
       textContents = fmap Rope.toText contents

plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs

@@ -12,6 +12,7 @@ import qualified Data.HashMap.Strict         as HM
 import           Data.Maybe                  (mapMaybe)
 import qualified Data.Text                   as T
 import           Development.IDE
+import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Core.Rules  (getHieFile)
 import qualified Development.IDE.Core.Shake  as Shake
 import           GHC.Generics                (Generic)
@@ -187,17 +188,18 @@ rules recorder plId = do
                 "Possible solutions:"
               ]
                 ++ map ("  - " <>) (inspectionSolution inspection)
-        return ( file,
-          ShowDiag,
-          LSP.Diagnostic
-            { _range = realSrcSpanToRange observationSrcSpan,
-              _severity = Just LSP.DiagnosticSeverity_Hint,
-              _code = Just (LSP.InR $ unId (inspectionId inspection)),
-              _source = Just "stan",
-              _message = message,
-              _relatedInformation = Nothing,
-              _tags = Nothing,
-              _codeDescription = Nothing,
-              _data_ = Nothing
-            }
-          )
+        return $
+          ideErrorFromLspDiag
+            LSP.Diagnostic
+              { _range = realSrcSpanToRange observationSrcSpan,
+                _severity = Just LSP.DiagnosticSeverity_Hint,
+                _code = Just (LSP.InR $ unId (inspectionId inspection)),
+                _source = Just "stan",
+                _message = message,
+                _relatedInformation = Nothing,
+                _tags = Nothing,
+                _codeDescription = Nothing,
+                _data_ = Nothing
+              }
+            file
+            Nothing