Fix Change Type Signature Plugin test suite for 9.2.1 (#2761)

* Add change-type-signature test suite and enable alternate-number-format for 9.2

* Revert 9.2.1 enable tests for alternate-number-format

* Clean up test file

* GHC 9.2.1 test fixes

* -Wall fixes

* Add  to fix test failures

* Bump Version

Author: drsooch

.github/workflows/test.yml

@@ -236,6 +236,10 @@ jobs:
         name: Test hls-selection-range-plugin test suite
         run: cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-selection-range-plugin --test-options="$TEST_OPTS"
 
+      - if: matrix.test
+        name: Test hls-change-type-signature test suite
+        run: cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS"
+
   test_post_job:
     if: always()
     runs-on: ubuntu-latest

plugins/hls-change-type-signature-plugin/README.md

@@ -14,3 +14,8 @@ If the plugin receives enough information it can correctly change the signature.
 ## Changelog
 ### 1.0.0.0
 - First Release
+
+### 1.0.1.0
+- Fix 9.2 Test failures (`waitForProgressDone`)
+- Add extra test scenarios for error message diffs in 9.2
+- Remove regex parsing for simple `Text` manipulation

plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               hls-change-type-signature-plugin
-version:            1.0.0.0
+version:            1.0.1.0
 synopsis:           Change a declarations type signature with a Code Action
 description:
   Please see the README on GitHub at <https://github.com/haskell/plugins/hls-change-type-signature-plugin/README.md>

plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs

@@ -66,7 +66,7 @@ data ChangeSignature = ChangeSignature {
                          , declSrcSpan :: RealSrcSpan
                          -- | the diagnostic to solve
                          , diagnostic  :: Diagnostic
-                                       }
+                         }
 
 -- | Constraint needed to trackdown OccNames in signatures
 type SigName = (HasOccName (IdP GhcPs))
@@ -99,6 +99,8 @@ errorMessageRegexes :: [Text]
 errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests
     "Expected type: (.+)\n +Actual type: (.+)\n(.|\n)+In an equation for ‘(.+)’"
     , "Couldn't match expected type ‘(.+)’ with actual type ‘(.+)’\n(.|\n)+In an equation for ‘(.+)’"
+    -- GHC >9.2 version of the first error regex
+    , "Expected: (.+)\n +Actual: (.+)\n(.|\n)+In an equation for ‘(.+)’"
     ]
 
 -- | Given a String with the name of a declaration, GHC's "Expected Type", find the declaration that matches
@@ -129,25 +131,18 @@ findSigLocOfStringDecl decls expectedType declName = something (const Nothing `e
         compareId (L _ id') = declName == occNameString (occName id')
 
 
-
 -- | Pretty Print the Type Signature (to validate GHC Error Message)
 sigToText :: Sig GhcPs -> Maybe Text
 sigToText = \case
-  ts@TypeSig {} -> stripSignature $ T.pack $ prettyPrint ts
+  ts@TypeSig {} -> Just $ stripSignature $ T.pack $ prettyPrint ts
   _             -> Nothing
 
-stripSignature :: Text -> Maybe Text
+stripSignature :: Text -> Text
 -- for whatever reason incoming signatures MAY have new lines after "::" or "=>"
-stripSignature sig = case T.filter (/= '\n') sig =~ sigRegex :: (Text, Text, Text, [Text]) of
-                        -- No constraints (Monad m =>)
-                         (_, _, _, [sig'])    -> Just $ T.strip sig'
-                        -- Ignore constraints (Monad m =>)
-                         (_, _, _, [_, sig']) -> Just $ T.strip sig'
-                         _                    -> Nothing
-    where
-        -- we want to test everthing after the constraints (GHC never gives us the constraint in the expected signature)
-        sigRegex = ".* :: (.*=>)?(.*)" :: Text
-
+stripSignature (T.filter (/= '\n') -> sig) = if T.isInfixOf " => " sig
+                                                -- remove constraints
+                                                then T.strip $ snd $ T.breakOnEnd " => " sig
+                                                else T.strip $ snd $ T.breakOnEnd " :: " sig
 
 changeSigToCodeAction :: Uri -> ChangeSignature -> Command |? CodeAction
 changeSigToCodeAction uri ChangeSignature{..} = InR CodeAction { _title       = mkChangeSigTitle declName actualType

plugins/hls-change-type-signature-plugin/test/Main.hs

@@ -1,31 +1,31 @@
 module Main where
 
+import           Control.Monad                  (void)
 import           Data.Either                    (rights)
 import           Data.Text                      (Text)
 import qualified Data.Text                      as T
 import qualified Data.Text.IO                   as TIO
 import           Ide.Plugin.ChangeTypeSignature (errorMessageRegexes)
 import qualified Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature
 import           System.FilePath                ((<.>), (</>))
-import           Test.Hls                       (CodeAction (..),
-                                                 CodeActionKind (CodeActionQuickFix),
-                                                 Command, IdeState,
+import           Test.Hls                       (CodeAction (..), Command,
+                                                 GhcVersion (GHC92), IdeState,
                                                  PluginDescriptor,
                                                  Position (Position),
                                                  Range (Range), Session,
                                                  TestName, TestTree,
                                                  TextDocumentIdentifier,
-                                                 assertBool, assertFailure,
+                                                 assertFailure,
                                                  defaultTestRunner,
                                                  executeCodeAction,
                                                  getCodeActions,
-                                                 goldenWithHaskellDoc, liftIO,
-                                                 openDoc, runSessionWithServer,
-                                                 testCase, testGroup, toEither,
-                                                 type (|?) (InR),
-                                                 waitForDiagnostics,
-                                                 waitForProgressDone, (@=?),
-                                                 (@?=))
+                                                 goldenWithHaskellDoc,
+                                                 knownBrokenForGhcVersions,
+                                                 liftIO, openDoc,
+                                                 runSessionWithServer, testCase,
+                                                 testGroup, toEither, type (|?),
+                                                 waitForAllProgressDone,
+                                                 waitForDiagnostics, (@?=))
 import           Text.Regex.TDFA                ((=~))
 
 main :: IO ()
@@ -36,23 +36,21 @@ changeTypeSignaturePlugin = ChangeTypeSignature.descriptor "changeTypeSignature"
 
 test :: TestTree
 test = testGroup "changeTypeSignature" [
-        codeActionTest "TExpectedActual" 4 11
-        , codeActionTest "TRigidType" 4 14
-        , codeActionTest "TLocalBinding" 6 21
-        , codeActionTest "TLocalBindingShadow1" 10 7
-        , codeActionTest "TLocalBindingShadow2" 6 21
+        testRegexes
+        , codeActionTest "TExpectedActual" 4 11
+        , knownBrokenForGhcVersions [GHC92] "Error Message in 9.2 does not provide enough info" $ codeActionTest "TRigidType" 4 14
+        , codeActionTest "TLocalBinding" 7 22
+        , codeActionTest "TLocalBindingShadow1" 11 8
+        , codeActionTest "TLocalBindingShadow2" 7 22
         , codeActionProperties "TErrorGivenPartialSignature" [(4, 13)] $ \actions -> liftIO $ length actions @?= 0
-        , testRegexes
     ]
 
 testRegexes :: TestTree
 testRegexes = testGroup "Regex Testing" [
         testRegexOne
         , testRegexTwo
+        , testRegex921One
     ]
-    where
-        regex1 = errorMessageRegexes !! 0
-        regex2 = errorMessageRegexes !! 1
 
 testRegexOne :: TestTree
 testRegexOne = testGroup "Regex One" [
@@ -76,6 +74,16 @@ testRegexTwo = testGroup "Regex Two" [
     where
         regex = errorMessageRegexes !! 1
 
+-- test ghc-9.2.1 error message regex
+testRegex921One :: TestTree
+testRegex921One = testGroup "Regex One" [
+        regexTest "ghc921-error1.txt" regex True
+        , regexTest "ghc921-error2.txt" regex True
+        , regexTest "ghc921-error3.txt" regex True
+    ]
+    where
+        regex = errorMessageRegexes !! 2
+
 testDataDir :: FilePath
 testDataDir = "test" </> "testdata"
 
@@ -84,7 +92,8 @@ goldenChangeSignature fp = goldenWithHaskellDoc changeTypeSignaturePlugin (fp <>
 
 codeActionTest :: FilePath -> Int -> Int -> TestTree
 codeActionTest fp line col = goldenChangeSignature fp $ \doc -> do
-    waitForDiagnostics  -- code actions are triggered from Diagnostics
+    void $ waitForDiagnostics  -- code actions are triggered from Diagnostics
+    void $ waitForAllProgressDone  -- apparently some tests need this to get the CodeAction to show up
     actions <- getCodeActions doc (pointRange line col)
     foundActions <- findChangeTypeActions actions
     liftIO $ length foundActions @?= 1

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.expected.hs

@@ -1,6 +1,8 @@
 module TLocalBinding where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
-local x = let test :: [Int] -> Int
-              test = head . reverse
+local x = let test :: t0 a0 -> (a0 -> m0 b0) -> m0 (t0 b0)
+              test = forM
           in x + 1

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.hs

@@ -1,6 +1,8 @@
 module TLocalBinding where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
 local x = let test :: Int -> Int
-              test = head . reverse
+              test = forM
           in x + 1

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.expected.hs

@@ -1,9 +1,11 @@
 module TLocalBindingShadow1 where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
 local x = let test :: Int -> Int
               test = (+2)
           in test x
 
-test :: [Double] -> Double
-test = head . reverse
+test :: [Double] -> (Double -> m0 b0) -> m0 [b0]
+test = forM

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.hs

@@ -1,9 +1,11 @@
 module TLocalBindingShadow1 where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
 local x = let test :: Int -> Int
               test = (+2)
           in test x
 
-test :: Int -> Double
-test = head . reverse
+test :: [Double] -> Double
+test = forM

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.expected.hs

@@ -1,8 +1,10 @@
 module TLocalBindingShadow2 where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
-local x = let test :: [Int] -> Int
-              test = head . reverse
+local x = let test :: t0 a0 -> (a0 -> m0 b0) -> m0 (t0 b0)
+              test = forM
           in test x
 
 test :: String -> String

plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.hs

@@ -1,8 +1,10 @@
 module TLocalBindingShadow2 where
 
+import Control.Monad (forM)
+
 local :: Int -> Int
 local x = let test :: Int -> Int
-              test = head . reverse
+              test = forM
           in test x
 
 test :: String -> String

plugins/hls-change-type-signature-plugin/test/testdata/ghc921-error1.txt

@@ -0,0 +1,9 @@
+    • Couldn't match type ‘Data.Set.Internal.Set Int’ with ‘Int’
+      Expected: Int -> [Int]
+        Actual: Data.Set.Internal.Set Int -> [Int]
+    • In the second argument of ‘(.)’, namely ‘toList’
+      In the expression: head . toList
+      In an equation for ‘test’: test = head . toList
+   |
+83 | test = head . toList
+   |               ^^^^^^

plugins/hls-change-type-signature-plugin/test/testdata/ghc921-error2.txt

@@ -0,0 +1,9 @@
+    • Couldn't match type ‘b0 -> a0 -> b0’ with ‘Int’
+      Expected: Int -> Int
+        Actual: (b0 -> a0 -> b0) -> b0 -> t0 a0 -> b0
+    • Probable cause: ‘foldl’ is applied to too few arguments
+      In the expression: foldl
+      In an equation for ‘test’: test = foldl
+   |
+83 | test = foldl
+   |

plugins/hls-change-type-signature-plugin/test/testdata/ghc921-error3.txt

@@ -0,0 +1,9 @@
+    • Couldn't match type ‘[Int]’ with ‘Int’
+      Expected: Int -> [Int]
+        Actual: [Int] -> [Int]
+    • In the second argument of ‘(.)’, namely ‘reverse’
+      In the expression: head . reverse
+      In an equation for ‘test’: test = head . reverse
+   |
+84 |               test = head . reverse
+   |