Make sure warnings use unqualified names where appropriate

Because we are constructing the message objects ourselves, as
opposed to error messages which are constructed by GHC, we need
to take care to respect the passed-in 'PprStyle'.

Author: hsenag

src/Development/IDE/GHC/Warnings.hs

@@ -29,8 +29,9 @@ withWarnings :: GhcMonad m => T.Text -> ((ModSummary -> ModSummary) -> m a) -> m
 withWarnings diagSource action = do
   warnings <- liftIO $ newVar []
   oldFlags <- getDynFlags
-  let newAction dynFlags _ _ loc _ msg = do
-        let d = diagFromErrMsg diagSource dynFlags $ mkPlainWarnMsg dynFlags loc msg
+  let newAction :: DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
+      newAction dynFlags _ _ loc style msg = do
+        let d = diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc (queryQual style) msg
         modifyVar_ warnings $ return . (d:)
   setLogAction newAction
   res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = newAction}}

test/exe/Main.hs

@@ -206,6 +206,24 @@ diagnosticTests = testGroup "diagnostics"
             ]
           )
         ]
+  , testSession "unqualified warnings" $ do
+      let fooContent = T.unlines
+            [ "{-# OPTIONS_GHC -Wredundant-constraints #-}"
+            , "module Foo where"
+            , "foo :: Ord a => a -> Int"
+            , "foo a = 1"
+            ]
+      _ <- openDoc' "Foo.hs" "haskell" fooContent
+      expectDiagnostics
+        [ ( "Foo.hs"
+      -- The test is to make sure that warnings contain unqualified names
+      -- where appropriate. The warning should use an unqualified name 'Ord', not
+      -- sometihng like 'GHC.Classes.Ord'. The choice of redundant-constraints to
+      -- test this is fairly arbitrary.
+          , [(DsWarning, (2, 0), "Redundant constraint: Ord a")
+            ]
+          )
+        ]
   ]
 
 codeActionTests :: TestTree