fix addTypeAnnotationsToLiteralsTest

Author: wavewave

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

@@ -827,6 +827,18 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range,
     | otherwise = []
     where
       makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")"
+#if MIN_VERSION_ghc(9,4,0)
+      pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable "
+                                       , ".*to type ‘([^ ]+)’ "
+                                       , "in the following constraint"
+                                       , if multiple then "s" else ""
+                                       , ".*arising from the literal ‘(.+)’"
+                                       , if inArg then ".+In the.+argument" else ""
+                                       , if at then ".+at" else ""
+                                       , if inExpr then ".+In the expression" else ""
+                                       , ".+In the expression"
+                                       ]
+#else
       pat multiple at inArg inExpr = T.concat [ ".*Defaulting the following constraint"
                                        , if multiple then "s" else ""
                                        , " to type ‘([^ ]+)’ "
@@ -836,12 +848,12 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range,
                                        , if inExpr then ".+In the expression" else ""
                                        , ".+In the expression"
                                        ]
+#endif
       codeEdit ty lit replacement =
         let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’"
             edits = [TextEdit _range replacement]
         in  [( title, edits )]
 
-
 -- | GHC strips out backticks in case of infix functions as well as single quote
 --   in case of quoted name when using TemplateHaskellQuotes. Which is not desired.
 --

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

@@ -2530,7 +2530,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f = 1"
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (3, 4), "Defaulting the type variable") ]
+#else
     [ (DsWarning, (3, 4), "Defaulting the following constraint") ]
+#endif
     "Add type annotation ‘Integer’ to ‘1’"
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "module A (f) where"
@@ -2547,7 +2551,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , "    let x = 3"
                , "    in x"
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (4, 12), "Defaulting the type variable") ]
+#else
     [ (DsWarning, (4, 12), "Defaulting the following constraint") ]
+#endif
     "Add type annotation ‘Integer’ to ‘3’"
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "module A where"
@@ -2565,7 +2573,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , "    let x = let y = 5 in y"
                , "    in x"
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (4, 20), "Defaulting the type variable") ]
+#else
     [ (DsWarning, (4, 20), "Defaulting the following constraint") ]
+#endif
     "Add type annotation ‘Integer’ to ‘5’"
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "module A where"
@@ -2584,9 +2596,15 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f = seq \"debug\" traceShow \"debug\""
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (6, 8), "Defaulting the type variable")
+    , (DsWarning, (6, 16), "Defaulting the type variable")
+    ]
+#else
     [ (DsWarning, (6, 8), "Defaulting the following constraint")
     , (DsWarning, (6, 16), "Defaulting the following constraint")
     ]
+#endif
     ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "{-# LANGUAGE OverloadedStrings #-}"
@@ -2596,7 +2614,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\""
                ])
-  , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $
+  , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $
     testSession "add default type to satisfy two constraints" $
     testFor
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
@@ -2607,7 +2625,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f a = traceShow \"debug\" a"
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (6, 6), "Defaulting the type variable") ]
+#else
     [ (DsWarning, (6, 6), "Defaulting the following constraint") ]
+#endif
     ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "{-# LANGUAGE OverloadedStrings #-}"
@@ -2617,7 +2639,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a"
                ])
-  , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $
+  , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $
     testSession "add default type to satisfy two constraints with duplicate literals" $
     testFor
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
@@ -2628,7 +2650,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
                , ""
                , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))"
                ])
+#if MIN_VERSION_ghc(9,4,0)
+    [ (DsWarning, (6, 54), "Defaulting the type variable") ]
+#else
     [ (DsWarning, (6, 54), "Defaulting the following constraint") ]
+#endif
     ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
     (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
                , "{-# LANGUAGE OverloadedStrings #-}"
@@ -3245,15 +3271,15 @@ removeRedundantConstraintsTests = let
     "Remove redundant constraints `(Monoid a, Show a)` from the context of the type signature for `foo`"
     (typeSignatureSpaces $ Just "Monoid a, Show a")
     (typeSignatureSpaces Nothing)
-    , check
+  , check
     "Remove redundant constraint `Eq a` from the context of the type signature for `foo`"
     typeSignatureLined1
     typeSignatureOneLine
-    , check
+  , check
     "Remove redundant constraints `(Eq a, Show a)` from the context of the type signature for `foo`"
     typeSignatureLined2
     typeSignatureOneLine
-    , check
+  , check
     "Remove redundant constraint `Show a` from the context of the type signature for `foo`"
     typeSignatureLined3
     typeSignatureLined3'
@@ -4006,4 +4032,3 @@ assertJust s = \case
 listOfChar :: T.Text
 listOfChar | ghcVersion >= GHC90 = "String"
            | otherwise = "[Char]"
-