Add field for expected error codes in ghcide tests

Author: dylan-thinnes

ghcide/test/exe/CPPTests.hs

@@ -42,15 +42,15 @@ tests =
           ,"  failed"
           ,"#endif"
           ]
-        expectDiagnostics [("A.hs", [(DiagnosticSeverity_Error, (3, 2), "Variable not in scope: worked")])]
+        expectDiagnostics [("A.hs", [(DiagnosticSeverity_Error, (3, 2), "Variable not in scope: worked", Nothing)])]
     ]
   where
     expectError :: T.Text -> Cursor -> Session ()
     expectError content cursor = do
       _ <- createDoc "Testing.hs" "haskell" content
       expectDiagnostics
         [ ( "Testing.hs",
-            [(DiagnosticSeverity_Error, cursor, "error: unterminated")]
+            [(DiagnosticSeverity_Error, cursor, "error: unterminated", Nothing)]
           )
         ]
       expectNoMoreDiagnostics 0.5

ghcide/test/exe/CradleTests.hs

@@ -112,7 +112,7 @@ simpleSubDirectoryTest =
     mainSource <- liftIO $ readFileUtf8 mainPath
     _mdoc <- createDoc mainPath "haskell" mainSource
     expectDiagnosticsWithTags
-      [("a/src/Main.hs", [(DiagnosticSeverity_Warning,(2,0), "Top-level binding", Nothing)]) -- So that we know P has been loaded
+      [("a/src/Main.hs", [(DiagnosticSeverity_Warning,(2,0), "Top-level binding", Nothing, Nothing)]) -- So that we know P has been loaded
       ]
     expectNoMoreDiagnostics 0.5
 
@@ -210,7 +210,7 @@ sessionDepsArePickedUp = testWithDummyPluginEmpty'
         "cradle: {direct: {arguments: []}}"
     -- Open without OverloadedStrings and expect an error.
     doc <- createDoc "Foo.hs" "haskell" fooContent
-    expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (3, 6), "Couldn't match type")])]
+    expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (3, 6), "Couldn't match type", Nothing)])]
 
     -- Update hie.yaml to enable OverloadedStrings.
     liftIO $

ghcide/test/exe/DependentFileTest.hs

@@ -46,7 +46,7 @@ tests = testGroup "addDependentFile"
         _fooDoc <- createDoc "Foo.hs" "haskell" fooContent
         doc <- createDoc "Baz.hs" "haskell" bazContent
         expectDiagnostics
-            [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type")])]
+            [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type", Nothing)])]
         -- Now modify the dependent file
         liftIO $ writeFile depFilePath "B"
         sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams

ghcide/test/exe/DiagnosticTests.hs

@@ -48,7 +48,7 @@ tests = testGroup "diagnostics"
   [ testWithDummyPluginEmpty "fix syntax error" $ do
       let content = T.unlines [ "module Testing wher" ]
       doc <- createDoc "Testing.hs" "haskell" content
-      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error")])]
+      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error", Nothing)])]
       let change = TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
               { _range = Range (Position 0 15) (Position 0 19)
               , _rangeLength = Nothing
@@ -67,18 +67,18 @@ tests = testGroup "diagnostics"
               , _text = "wher"
               }
       changeDoc doc [change]
-      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error")])]
+      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error", Nothing)])]
   , testWithDummyPluginEmpty "update syntax error" $ do
       let content = T.unlines [ "module Testing(missing) where" ]
       doc <- createDoc "Testing.hs" "haskell" content
-      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'missing'")])]
+      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'missing'", Nothing)])]
       let change = TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
               { _range = Range (Position 0 15) (Position 0 16)
               , _rangeLength = Nothing
               , _text = "l"
               }
       changeDoc doc [change]
-      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'lissing'")])]
+      expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'lissing'", Nothing)])]
   , testWithDummyPluginEmpty "variable not in scope" $ do
       let content = T.unlines
             [ "module Testing where"
@@ -90,8 +90,8 @@ tests = testGroup "diagnostics"
       _ <- createDoc "Testing.hs" "haskell" content
       expectDiagnostics
         [ ( "Testing.hs"
-          , [ (DiagnosticSeverity_Error, (2, 15), "Variable not in scope: ab")
-            , (DiagnosticSeverity_Error, (4, 11), "Variable not in scope: cd")
+          , [ (DiagnosticSeverity_Error, (2, 15), "Variable not in scope: ab", Nothing)
+            , (DiagnosticSeverity_Error, (4, 11), "Variable not in scope: cd", Nothing)
             ]
           )
         ]
@@ -104,7 +104,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "Testing.hs" "haskell" content
       expectDiagnostics
         [ ( "Testing.hs"
-          , [(DiagnosticSeverity_Error, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
+          , [(DiagnosticSeverity_Error, (2, 14), "Couldn't match type '[Char]' with 'Int'", Nothing)]
           )
         ]
   , testWithDummyPluginEmpty "typed hole" $ do
@@ -116,7 +116,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "Testing.hs" "haskell" content
       expectDiagnostics
         [ ( "Testing.hs"
-          , [(DiagnosticSeverity_Error, (2, 8), "Found hole: _ :: Int -> String")]
+          , [(DiagnosticSeverity_Error, (2, 8), "Found hole: _ :: Int -> String", Nothing)]
           )
         ]
 
@@ -132,8 +132,8 @@ tests = testGroup "diagnostics"
           , "b = True"]
         bMessage = "Couldn't match expected type 'Float' with actual type 'Bool'"
         expectedDs aMessage =
-          [ ("A.hs", [(DiagnosticSeverity_Error, (2,4), aMessage)])
-          , ("B.hs", [(DiagnosticSeverity_Error, (3,4), bMessage)])]
+          [ ("A.hs", [(DiagnosticSeverity_Error, (2,4), aMessage, Nothing)])
+          , ("B.hs", [(DiagnosticSeverity_Error, (3,4), bMessage, Nothing)])]
         deferralTest title binding msg = testWithDummyPluginEmpty title $ do
           _ <- createDoc "A.hs" "haskell" $ sourceA binding
           _ <- createDoc "B.hs" "haskell"   sourceB
@@ -158,14 +158,14 @@ tests = testGroup "diagnostics"
               , _text = ""
               }
       changeDoc docA [change]
-      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 0), "Could not find module")])]
+      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 0), "Could not find module", Nothing)])]
   , testWithDummyPluginEmpty "add missing module" $ do
       let contentB = T.unlines
             [ "module ModuleB where"
             , "import ModuleA ()"
             ]
       _ <- createDoc "ModuleB.hs" "haskell" contentB
-      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module")])]
+      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module", Nothing)])]
       let contentA = T.unlines [ "module ModuleA where" ]
       _ <- createDoc "ModuleA.hs" "haskell" contentA
       expectDiagnostics [("ModuleB.hs", [])]
@@ -185,7 +185,7 @@ tests = testGroup "diagnostics"
             , "import ModuleA ()"
             ]
       _ <- createDoc (tmpDir </> "ModuleB.hs") "haskell" contentB
-      expectDiagnostics [(tmpDir </> "ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module")])]
+      expectDiagnostics [(tmpDir </> "ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module", Nothing)])]
       let contentA = T.unlines [ "module ModuleA where" ]
       _ <- createDoc (tmpDir </> "ModuleA.hs") "haskell" contentA
       expectDiagnostics [(tmpDir </> "ModuleB.hs", [])]
@@ -202,10 +202,10 @@ tests = testGroup "diagnostics"
       _ <- createDoc "ModuleB.hs" "haskell" contentB
       expectDiagnostics
         [ ( "ModuleA.hs"
-          , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
+          , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB", Nothing)]
           )
         , ( "ModuleB.hs"
-          , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
+          , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB", Nothing)]
           )
         ]
   , let contentA = T.unlines [ "module ModuleA where" , "import ModuleB" ]
@@ -222,8 +222,8 @@ tests = testGroup "diagnostics"
         ]) $ do
       _ <- createDoc "ModuleD.hs" "haskell" contentD
       expectDiagnostics
-        [ ( "ModuleB.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")])
-        , ( "ModuleA.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")])
+        [ ( "ModuleB.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB", Nothing)])
+        , ( "ModuleA.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB", Nothing)])
         ]
   , testWithDummyPluginEmpty "cyclic module dependency with hs-boot" $ do
       let contentA = T.unlines
@@ -243,7 +243,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "ModuleA.hs" "haskell" contentA
       _ <- createDoc "ModuleB.hs" "haskell" contentB
       _ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
-      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
+      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding", Nothing)])]
   , testWithDummyPlugin "bidirectional module dependency with hs-boot"
         (mkIdeTestFs [directCradle ["ModuleA", "ModuleB"]])
         $ do
@@ -268,7 +268,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
       _ <- createDoc "ModuleB.hs" "haskell" contentB
       _ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
-      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
+      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding", Nothing)])]
   , testWithDummyPluginEmpty "correct reference used with hs-boot" $ do
       let contentB = T.unlines
             [ "module ModuleB where"
@@ -294,7 +294,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "ModuleA.hs" "haskell" contentA
       _ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
       _ <- createDoc "ModuleC.hs" "haskell" contentC
-      expectDiagnostics [("ModuleC.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
+      expectDiagnostics [("ModuleC.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding", Nothing)])]
   , testWithDummyPluginEmpty "redundant import" $ do
       let contentA = T.unlines ["module ModuleA where"]
       let contentB = T.unlines
@@ -306,7 +306,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "ModuleB.hs" "haskell" contentB
       expectDiagnosticsWithTags
         [ ( "ModuleB.hs"
-          , [(DiagnosticSeverity_Warning, (2, 0), "The import of 'ModuleA' is redundant", Just DiagnosticTag_Unnecessary)]
+          , [(DiagnosticSeverity_Warning, (2, 0), "The import of 'ModuleA' is redundant", Nothing, Just DiagnosticTag_Unnecessary)]
           )
         ]
   , testWithDummyPluginEmpty "redundant import even without warning" $ do
@@ -320,7 +320,7 @@ tests = testGroup "diagnostics"
             ]
       _ <- createDoc "ModuleA.hs" "haskell" contentA
       _ <- createDoc "ModuleB.hs" "haskell" contentB
-      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
+      expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding", Nothing)])]
   , testWithDummyPluginEmpty "package imports" $ do
       let thisDataListContent = T.unlines
             [ "module Data.List where"
@@ -348,14 +348,14 @@ tests = testGroup "diagnostics"
                 else if ghcVersion >= GHC94 then
                   "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130
                 else
-                  "Not in scope: \8216ThisList.map\8217")
+                  "Not in scope: \8216ThisList.map\8217", Nothing)
             ,(DiagnosticSeverity_Error, (7, 9),
                 if ghcVersion >= GHC96 then
                   "Variable not in scope: BaseList.x"
                 else if ghcVersion >= GHC94 then
                   "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130
                 else
-                  "Not in scope: \8216BaseList.x\8217")
+                  "Not in scope: \8216BaseList.x\8217", Nothing)
             ]
           )
         ]
@@ -373,7 +373,7 @@ tests = testGroup "diagnostics"
       -- where appropriate. The warning should use an unqualified name 'Ord', not
       -- something like 'GHC.Classes.Ord'. The choice of redundant-constraints to
       -- test this is fairly arbitrary.
-          , [(DiagnosticSeverity_Warning, (2, if ghcVersion >= GHC94 then 7 else 0), "Redundant constraint: Ord a")
+          , [(DiagnosticSeverity_Warning, (2, if ghcVersion >= GHC94 then 7 else 0), "Redundant constraint: Ord a", Nothing)
             ]
           )
         ]
@@ -439,7 +439,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "Foo.hs" "haskell" fooContent
       expectDiagnostics
         [ ( "Foo.hs"
-          , [(DiagnosticSeverity_Warning, (1, 0), "Top-level binding with no type signature:")
+          , [(DiagnosticSeverity_Warning, (1, 0), "Top-level binding with no type signature:", Nothing)
             ]
           )
         ]
@@ -453,7 +453,7 @@ tests = testGroup "diagnostics"
       _ <- createDoc "Foo.hs" "haskell" fooContent
       expectDiagnostics
         [ ( "Foo.hs"
-          , [(DiagnosticSeverity_Warning, (3, 0), "Defined but not used:")
+          , [(DiagnosticSeverity_Warning, (3, 0), "Defined but not used:", Nothing)
             ]
           )
         ]
@@ -469,13 +469,13 @@ tests = testGroup "diagnostics"
     bdoc <- createDoc bPath "haskell" bSource
     _pdoc <- createDoc pPath "haskell" pSource
     expectDiagnostics
-      [("P.hs", [(DiagnosticSeverity_Warning,(4,0), "Top-level binding")])] -- So that we know P has been loaded
+      [("P.hs", [(DiagnosticSeverity_Warning,(4,0), "Top-level binding", Nothing)])] -- So that we know P has been loaded
 
     -- Change y from Int to B which introduces a type error in A (imported from P)
     changeDoc bdoc [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $
                     T.unlines ["module B where", "y :: Bool", "y = undefined"]]
     expectDiagnostics
-      [("A.hs", [(DiagnosticSeverity_Error, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'")])
+      [("A.hs", [(DiagnosticSeverity_Error, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'", Nothing)])
       ]
 
     -- Open A and edit to fix the type error
@@ -485,8 +485,8 @@ tests = testGroup "diagnostics"
 
     expectDiagnostics
       [ ( "P.hs",
-          [ (DiagnosticSeverity_Error, (4, 6), "Couldn't match expected type 'Int' with actual type 'Bool'"),
-            (DiagnosticSeverity_Warning, (4, 0), "Top-level binding")
+          [ (DiagnosticSeverity_Error, (4, 6), "Couldn't match expected type 'Int' with actual type 'Bool'", Nothing),
+            (DiagnosticSeverity_Warning, (4, 0), "Top-level binding", Nothing)
           ]
         ),
         ("A.hs", [])
@@ -496,14 +496,14 @@ tests = testGroup "diagnostics"
   , testWithDummyPluginEmpty "deduplicate missing module diagnostics" $  do
       let fooContent = T.unlines [ "module Foo() where" , "import MissingModule" ]
       doc <- createDoc "Foo.hs" "haskell" fooContent
-      expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (1,7), "Could not find module 'MissingModule'")])]
+      expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (1,7), "Could not find module 'MissingModule'", Nothing)])]
 
       changeDoc doc [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ "module Foo() where" ]
       expectDiagnostics []
 
       changeDoc doc [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ T.unlines
             [ "module Foo() where" , "import MissingModule" ] ]
-      expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (1,7), "Could not find module 'MissingModule'")])]
+      expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (1,7), "Could not find module 'MissingModule'", Nothing)])]
 
   , testGroup "Cancellation"
     [ cancellationTestGroup "edit header" editHeader yesSession noParse  noTc
@@ -564,7 +564,7 @@ cancellationTemplate (edit, undoEdit) mbKey = testCase (maybe "-" fst mbKey) $ r
             ]
 
       -- for the example above we expect one warning
-      let missingSigDiags = [(DiagnosticSeverity_Warning, (3, 0), "Top-level binding") ]
+      let missingSigDiags = [(DiagnosticSeverity_Warning, (3, 0), "Top-level binding", Nothing) ]
       typeCheck doc >> expectCurrentDiagnostics doc missingSigDiags
 
       -- Now we edit the document and wait for the given key (if any)

ghcide/test/exe/FindDefinitionAndHoverTests.hs

@@ -88,8 +88,8 @@ tests = let
     , testGroup "hover"      $ mapMaybe snd tests
     , testGroup "hover compile" [checkFileCompiles sourceFilePath $
         expectDiagnostics
-          [ ( "GotoHover.hs", [(DiagnosticSeverity_Error, (62, 7), "Found hole: _")])
-          , ( "GotoHover.hs", [(DiagnosticSeverity_Error, (65, 8), "Found hole: _")])
+          [ ( "GotoHover.hs", [(DiagnosticSeverity_Error, (62, 7), "Found hole: _", Nothing)])
+          , ( "GotoHover.hs", [(DiagnosticSeverity_Error, (65, 8), "Found hole: _", Nothing)])
           ]]
     , testGroup "type-definition" typeDefinitionTests
     , testGroup "hover-record-dot-syntax" recordDotSyntaxTests ]

ghcide/test/exe/GarbageCollectionTests.hs

@@ -72,7 +72,7 @@ tests = testGroup "garbage collection"
             changeDoc doc [TextDocumentContentChangeEvent . InR $ TextDocumentContentChangeWholeDocument edit]
             builds <- waitForTypecheck doc
             liftIO $ assertBool "it still builds" builds
-            expectCurrentDiagnostics doc [(DiagnosticSeverity_Error, (2,4), "Couldn't match expected type")]
+            expectCurrentDiagnostics doc [(DiagnosticSeverity_Error, (2,4), "Couldn't match expected type", Nothing)]
         ]
   ]
   where