Fix build issues with other tests from expectDiagnostics

Author: dylan-thinnes

ghcide-bench/src/Experiments.hs

@@ -266,7 +266,7 @@ experiments =
             flip allM docs $ \DocumentPositions{..} -> do
                 bottom <- pred . length . T.lines <$> documentContents doc
                 diags <- getCurrentDiagnostics doc
-                case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Nothing) of
+                case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Just "88464", Nothing) of
                     Nothing   -> pure True
                     Just _err -> pure False
         ),

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

@@ -1996,7 +1996,7 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti
     compareHideFunctionTo = compareTwo "HideFunction.hs"
     withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do
         doc <- openDoc file "haskell"
-        void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error, loc, "Ambiguous occurrence") | loc <- locs])]
+        void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error, loc, "Ambiguous occurrence", Nothing) | loc <- locs])] -- TODO: Give this a proper error
         actions <- getAllCodeActions doc
         k dir doc actions
     withHideFunction = withTarget ("HideFunction" <.> "hs")
@@ -2455,7 +2455,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
   where
     testFor sourceLines pos@(l,c) expectedTitle expectedLines = do
       docId <- createDoc "A.hs" "haskell" $ T.unlines sourceLines
-      expectDiagnostics [ ("A.hs", [(DiagnosticSeverity_Warning, pos, "not used")]) ]
+      expectDiagnostics [ ("A.hs", [(DiagnosticSeverity_Warning, pos, "not used", Nothing)]) ]
       action <- pickActionWithTitle expectedTitle =<< getCodeActions docId  (R l c l c)
       executeCodeAction action
       contentAfterAction <- documentContents docId
@@ -2471,8 +2471,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       , "f = 1"
       ]
       (if ghcVersion >= GHC94
-        then [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the type variable") ]
-        else [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the following constraint") ])
+        then [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the type variable", Nothing) ]
+        else [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the following constraint", Nothing) ])
       "Add type annotation ‘Integer’ to ‘1’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
       , "module A (f) where"
@@ -2490,8 +2490,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       , "    in x"
       ]
       (if ghcVersion >= GHC94
-        then [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the type variable") ]
-        else [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the following constraint") ])
+        then [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the type variable", Nothing) ]
+        else [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the following constraint", Nothing) ])
       "Add type annotation ‘Integer’ to ‘3’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
       , "module A where"
@@ -2510,8 +2510,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       , "    in x"
       ]
       (if ghcVersion >= GHC94
-        then [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the type variable") ]
-        else [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the following constraint") ])
+        then [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the type variable", Nothing) ]
+        else [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the following constraint", Nothing) ])
       "Add type annotation ‘Integer’ to ‘5’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
       , "module A where"
@@ -2532,12 +2532,12 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       ]
       (if ghcVersion >= GHC94
         then
-          [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the type variable")
-          , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the type variable")
+          [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the type variable", Nothing)
+          , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the type variable", Nothing)
           ]
         else
-          [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the following constraint")
-          , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the following constraint")
+          [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the following constraint", Nothing)
+          , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the following constraint", Nothing)
           ])
       "Add type annotation ‘String’ to ‘\"debug\"’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
@@ -2559,8 +2559,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       , "f a = traceShow \"debug\" a"
       ]
       (if ghcVersion >= GHC94
-        then [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the type variable") ]
-        else [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the following constraint") ])
+        then [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the type variable", Nothing) ]
+        else [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the following constraint", Nothing) ])
       "Add type annotation ‘String’ to ‘\"debug\"’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
       , "{-# LANGUAGE OverloadedStrings #-}"
@@ -2581,8 +2581,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
       , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))"
       ]
       (if ghcVersion >= GHC94
-        then [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the type variable") ]
-        else [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the following constraint") ])
+        then [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the type variable", Nothing) ]
+        else [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the following constraint", Nothing) ])
       "Add type annotation ‘String’ to ‘\"debug\"’"
       [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
       , "{-# LANGUAGE OverloadedStrings #-}"
@@ -2597,7 +2597,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
     testFor sourceLines diag expectedTitle expectedLines = do
       docId <- createDoc "A.hs" "haskell" $ T.unlines sourceLines
       expectDiagnostics [ ("A.hs", diag) ]
-      let cursors = map snd3 diag
+      let cursors = map (\(_, snd, _, _) -> snd) diag
           (ls, cs) = minimum cursors
           (le, ce) = maximum cursors
 

test/functional/Config.hs

@@ -67,8 +67,8 @@ genericConfigTests = testGroup "generic plugin config"
             expectDiagnostics standardDiagnostics
     ]
     where
-        standardDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Warning, (1,0), "Top-level binding")])]
-        testPluginDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Error, (0,0), "testplugin")])]
+        standardDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Warning, (1,0), "Top-level binding", Nothing)])]
+        testPluginDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Error, (0,0), "testplugin", Nothing)])]
 
         runConfigSession subdir session = do
           failIfSessionTimeout $
@@ -90,7 +90,7 @@ genericConfigTests = testGroup "generic plugin config"
                     files <- getFilesOfInterestUntracked
                     void $ uses_ GetTestDiagnostics $ HM.keys files
               define mempty $ \GetTestDiagnostics file -> do
-                let diags = [ideErrorText file "testplugin"]
+                let diags = [ideErrorText Nothing file "testplugin"]
                 return (diags,Nothing)
           }
         -- A config that disables the plugin initially