Resolve fendor's feedback

Author: Jaro Reinders

ghcide-bench/src/Experiments.hs

@@ -266,7 +266,7 @@ experiments =
             flip allM docs $ \DocumentPositions{..} -> do
                 bottom <- pred . length . T.lines <$> documentContents doc
                 diags <- getCurrentDiagnostics doc
-                case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Just "88464", Nothing) of
+                case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Just "GHC-88464", Nothing) of
                     Nothing   -> pure True
                     Just _err -> pure False
         ),

ghcide/src/Development/IDE/Core/Compile.hs

@@ -163,9 +163,9 @@ computePackageDeps env pkg = do
         Nothing ->
           return $ Left
             [ ideErrorText
-                Nothing
                 (toNormalizedFilePath' noFilePath)
                 (T.pack $ "unknown package: " ++ show pkg)
+                Nothing
             ]
         Just pkgInfo -> return $ Right $ unitDepends pkgInfo
 

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -142,7 +142,7 @@ getModificationTimeImpl missingFileDiags file = do
                 `catch` \(e :: IOException) -> do
                     let err | isDoesNotExistError e = "File does not exist: " ++ file'
                             | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
-                        diag = ideErrorText Nothing file (T.pack err)
+                        diag = ideErrorText file (T.pack err) Nothing
                     if isDoesNotExistError e && not missingFileDiags
                         then return (Nothing, ([], Nothing))
                         else return (Nothing, ([diag], Nothing))

ghcide/src/Development/IDE/Core/Shake.hs

@@ -1248,7 +1248,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do
                 (mbBs, (diags, mbRes)) <- actionCatch
                     (do v <- action staleV; liftIO $ evaluate $ force v) $
                     \(e :: SomeException) -> do
-                        pure (Nothing, ([ideErrorText Nothing file $ T.pack $ show e | not $ isBadDependency e],Nothing))
+                        pure (Nothing, ([ideErrorText file (T.pack $ show e) Nothing | not $ isBadDependency e],Nothing))
 
                 ver <- estimateFileVersionUnsafely key mbRes file
                 (bs, res) <- case mbRes of

ghcide/src/Development/IDE/Types/Diagnostics.hs

@@ -76,8 +76,8 @@ type IdeResult v = ([FileDiagnostic], Maybe v)
 -- | an IdeResult with a fingerprint
 type IdeResultNoDiagnosticsEarlyCutoff  v = (Maybe ByteString, Maybe v)
 
-ideErrorText :: Maybe (MsgEnvelope GhcMessage) -> NormalizedFilePath -> T.Text -> FileDiagnostic
-ideErrorText origMsg fdFilePath msg =
+ideErrorText :: NormalizedFilePath -> T.Text -> Maybe (MsgEnvelope GhcMessage) -> FileDiagnostic
+ideErrorText fdFilePath msg origMsg =
   ideErrorWithSource (Just "compiler") (Just DiagnosticSeverity_Error) fdFilePath msg origMsg
 
 ideErrorFromLspDiag
@@ -119,8 +119,6 @@ showGhcCode = T.pack . show
 showGhcCode :: DiagnosticCode -> T.Text
 showGhcCode (DiagnosticCode prefix c) = T.pack $ prefix ++ "-" ++ printf "%05d" c
 #endif
-  in
-  FileDiagnostic {..}
 
 attachedReason :: Traversal' Diagnostic (Maybe JSON.Value)
 attachedReason = data_ . non (JSON.object []) . JSON.atKey "attachedReason"

hls-test-utils/src/Development/IDE/Test/Diagnostic.hs

@@ -6,6 +6,7 @@ import qualified Data.Text                   as T
 import           GHC.Stack                   (HasCallStack)
 import           Language.LSP.Protocol.Lens
 import           Language.LSP.Protocol.Types
+import           Development.IDE.GHC.Compat (ghcVersion, GhcVersion (..))
 
 -- | (0-based line number, 0-based column number)
 type Cursor = (UInt, UInt)
@@ -35,15 +36,13 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg, mbExpectedCod
         && hasTag expectedTag (d ^. tags)
         && codeMatches d
 
-    codeMatches d =
-#if MIN_VERSION_GLASGOW_HASKELL(9,5,0,0)
+    codeMatches d
+      | ghcVersion >= GHC96 =
         case (mbExpectedCode, _code d) of
           (Nothing, _)                         -> True
           (Just expectedCode, Nothing)         -> False
           (Just expectedCode, Just actualCode) -> InR expectedCode == actualCode
-#else
-        True
-#endif
+      | otherwise =  True
 
     hasTag :: Maybe DiagnosticTag -> Maybe [DiagnosticTag] -> Bool
     hasTag Nothing  _                   = True

test/functional/Config.hs

@@ -90,7 +90,7 @@ genericConfigTests = testGroup "generic plugin config"
                     files <- getFilesOfInterestUntracked
                     void $ uses_ GetTestDiagnostics $ HM.keys files
               define mempty $ \GetTestDiagnostics file -> do
-                let diags = [ideErrorText Nothing file "testplugin"]
+                let diags = [ideErrorText file "testplugin" Nothing]
                 return (diags,Nothing)
           }
         -- A config that disables the plugin initially