Fix hls-pragma-plugin tests

Author: fendor

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

@@ -37,7 +37,7 @@ import           Control.Lens
 import qualified Data.Aeson                     as JSON
 import qualified Data.Aeson.Lens                as JSON
 import           Data.ByteString                (ByteString)
-import           Data.List
+import           Data.Foldable
 import           Data.Maybe                     as Maybe
 import qualified Data.Text                      as T
 import           Development.IDE.GHC.Compat     (GhcMessage, MsgEnvelope,
@@ -146,7 +146,10 @@ attachReason Nothing = id
 attachReason (Just wr) = attachedReason .~ fmap JSON.toJSON (showReason wr)
  where
   showReason = \case
-    WarningWithFlag flag -> showFlag flag
+    WarningWithFlag flag -> Just $ catMaybes [showFlag flag]
+#if MIN_VERSION_ghc(9,7,0)
+    WarningWithFlags flags -> Just $ catMaybes (fmap showFlag $ toList flags)
+#endif
     _                    -> Nothing
 
 showFlag :: WarningFlag -> Maybe T.Text

plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs

@@ -19,6 +19,7 @@ import           Control.Lens                             hiding (List)
 import           Control.Monad.IO.Class                   (MonadIO (liftIO))
 import qualified Data.Aeson                               as JSON
 import           Data.Char                                (isAlphaNum)
+import qualified Data.Foldable                            as Foldable
 import           Data.List.Extra                          (nubOrdOn)
 import qualified Data.Map                                 as M
 import           Data.Maybe                               (mapMaybe)
@@ -122,10 +123,13 @@ suggest dflags diag =
 
 suggestDisableWarning :: Diagnostic -> [PragmaEdit]
 suggestDisableWarning diagnostic
-  | Just (Just (JSON.String attachedReason)) <- diagnostic ^? attachedReason
-  , Just w <- T.stripPrefix "-W" attachedReason
-  , w `notElem` warningBlacklist =
-    pure ("Disable \"" <> w <> "\" warnings", OptGHC w)
+  | Just (Just (JSON.Array attachedReasons)) <- diagnostic ^? attachedReason
+    =
+    [ ("Disable \"" <> w <> "\" warnings", OptGHC w)
+    | JSON.String attachedReason <- Foldable.toList attachedReasons
+    , Just w <- [T.stripPrefix "-W" attachedReason]
+    , w `notElem` warningBlacklist
+    ]
   | otherwise = []
 
 warningBlacklist :: [T.Text]

plugins/hls-pragmas-plugin/test/Main.hs

@@ -73,10 +73,10 @@ codeActionTests =
   , codeActionTestWithPragmasSuggest "adds TypeApplications pragma" "TypeApplications" [("Add \"TypeApplications\"", "Contains TypeApplications code action")]
   , codeActionTestWithPragmasSuggest "after shebang" "AfterShebang" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]
   , codeActionTestWithPragmasSuggest "append to existing pragmas" "AppendToExisting" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]
-  , codeActionTestWithPragmasSuggest "before doc comments" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]
+  , codeActionTestWithPragmasSuggest "before doc comments NamedFieldPuns" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]
   , codeActionTestWithPragmasSuggest "adds TypeSynonymInstances pragma" "NeedsPragmas" [("Add \"TypeSynonymInstances\"", "Contains TypeSynonymInstances code action"), ("Add \"FlexibleInstances\"", "Contains FlexibleInstances code action")]
-  , codeActionTestWithDisableWarning "before doc comments" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")]
-  , codeActionTestWithDisableWarning "before doc comments" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")]
+  , codeActionTestWithDisableWarning "before doc comments missing-signatures" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")]
+  , codeActionTestWithDisableWarning "before doc comments unused-imports" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")]
   ]
 
 codeActionTestWithPragmasSuggest :: String -> FilePath -> [(T.Text, String)] -> TestTree