Remove interface loading diagnostics (#579)

* Drop interface loading diagnostics

* No reason to skip the --test flag anymore

Author: pepeiborra

exe/Main.hs

@@ -102,7 +102,6 @@ main = do
                     , optShakeProfiling = argsShakeProfiling
                     , optTesting        = argsTesting
                     , optThreads        = argsThreads
-                    , optInterfaceLoadingDiagnostics = argsTesting
                     }
             debouncer <- newAsyncDebouncer
             initialise caps (cradleRules >> mainRule >> pluginRules plugins >> action kick)

src/Development/IDE/Core/Rules.hs

@@ -550,36 +550,19 @@ getHiFileRule = defineEarlyCutoff $ \GetHiFile f -> do
                 HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)
                 _ -> ml_hi_file $ ms_location ms
 
-  IdeOptions{optInterfaceLoadingDiagnostics} <- getIdeOptions
-
-  let mkInterfaceFilesGenerationDiag f intro
-        | optInterfaceLoadingDiagnostics = mkDiag $ intro <> msg
-        | otherwise = []
-            where
-                msg =
-                    ": additional resource use while generating interface files in the background."
-                mkDiag = pure
-                       . ideErrorWithSource (Just "interface file loading") (Just DsInfo) f
-                       . T.pack
-
   case sequence depHis of
-    Nothing -> do
-          let d = mkInterfaceFilesGenerationDiag f "Missing interface file dependencies"
-          pure (Nothing, (d, Nothing))
+    Nothing -> pure (Nothing, ([], Nothing))
     Just deps -> do
       gotHiFile <- getFileExists hiFile
       if not gotHiFile
-        then do
-          let d = mkInterfaceFilesGenerationDiag f "Missing interface file"
-          pure (Nothing, (d, Nothing))
+        then pure (Nothing, ([], Nothing))
         else do
           hiVersion  <- use_ GetModificationTime hiFile
           modVersion <- use_ GetModificationTime f
           let sourceModified = modificationTime hiVersion < modificationTime modVersion
           if sourceModified
             then do
-              let d = mkInterfaceFilesGenerationDiag f "Stale interface file"
-              pure (Nothing, (d, Nothing))
+              pure (Nothing, ([], Nothing))
             else do
               session <- hscEnv <$> use_ GhcSession f
               r <- liftIO $ loadInterface session ms deps

src/Development/IDE/Types/Options.hs

@@ -58,8 +58,6 @@ data IdeOptions = IdeOptions
     --   features such as diagnostics and go-to-definition, in
     --   situations in which they would become unavailable because of
     --   the presence of type errors, holes or unbound variables.
-  , optInterfaceLoadingDiagnostics :: Bool
-    -- ^ Generate Info-level diagnostics to report interface loading actions
   }
 
 data IdePreprocessedSource = IdePreprocessedSource
@@ -93,7 +91,6 @@ defaultIdeOptions session = IdeOptions
     ,optKeywords = haskellKeywords
     ,optDefer = IdeDefer True
     ,optTesting = False
-    ,optInterfaceLoadingDiagnostics = False
     }
 
 

test/exe/Main.hs

@@ -2033,8 +2033,8 @@ cradleTests = testGroup "cradle"
 
 loadCradleOnlyonce :: TestTree
 loadCradleOnlyonce = testGroup "load cradle only once"
-    [ testSessionTF "implicit" implicit
-    , testSessionTF "direct"   direct
+    [ testSession' "implicit" implicit
+    , testSession' "direct"   direct
     ]
     where
         direct dir = do
@@ -2143,10 +2143,7 @@ testSession :: String -> Session () -> TestTree
 testSession name = testCase name . run
 
 testSession' :: String -> (FilePath -> Session ()) -> TestTree
-testSession' name = testCase name . run' NoTestFlag
-
-testSessionTF :: String -> (FilePath -> Session ()) -> TestTree
-testSessionTF name = testCase name . run' WithTestFlag
+testSession' name = testCase name . run'
 
 testSessionWait :: String -> Session () -> TestTree
 testSessionWait name = testSession name .
@@ -2177,16 +2174,13 @@ mkRange :: Int -> Int -> Int -> Int -> Range
 mkRange a b c d = Range (Position a b) (Position c d)
 
 run :: Session a -> IO a
-run s = withTempDir $ \dir -> runInDir NoTestFlag dir s
-
-run' :: WithTestFlag -> (FilePath -> Session a) -> IO a
-run' tf s = withTempDir $ \dir -> runInDir tf dir (s dir)
+run s = withTempDir $ \dir -> runInDir dir s
 
--- Do we run the LSP executable with --test or not
-data WithTestFlag = WithTestFlag | NoTestFlag deriving (Show, Eq)
+run' :: (FilePath -> Session a) -> IO a
+run' s = withTempDir $ \dir -> runInDir dir (s dir)
 
-runInDir :: WithTestFlag -> FilePath -> Session a -> IO a
-runInDir withTestFlag dir s = do
+runInDir :: FilePath -> Session a -> IO a
+runInDir dir s = do
   ghcideExe <- locateGhcideExecutable
 
   -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56
@@ -2199,8 +2193,7 @@ runInDir withTestFlag dir s = do
     createDirectoryIfMissing True $ dir </> takeDirectory f
     copyFile ("test/data" </> f) (dir </> f)
 
-  let cmd = unwords ([ghcideExe, "--lsp", "--cwd", dir]
-                    ++ [ "--test" | WithTestFlag == withTestFlag ])
+  let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", dir]
   -- HIE calls getXgdDirectory which assumes that HOME is set.
   -- Only sets HOME if it wasn't already set.
   setEnv "HOME" "/homeless-shelter" False

test/src/Development/IDE/Test.hs

@@ -16,7 +16,6 @@ import Control.Applicative.Combinators
 import Control.Lens hiding (List)
 import Control.Monad
 import Control.Monad.IO.Class
-import           Data.Foldable
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import Language.Haskell.LSP.Test hiding (message)
@@ -74,17 +73,14 @@ expectNoMoreDiagnostics timeout = do
     ignoreOthers = void anyMessage >> handleMessages
 
 expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
-expectDiagnostics = expectDiagnostics' diagnostic
-
-expectDiagnostics' :: Session PublishDiagnosticsNotification -> [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
-expectDiagnostics' messageParser expected = do
+expectDiagnostics expected = do
     expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) (fmap toNormalizedUri . getDocUri) expected
     go expected'
     where
         go m
             | Map.null m = pure ()
             | otherwise = do
-                  diagsNot <- skipManyTill anyMessage messageParser
+                  diagsNot <- skipManyTill anyMessage diagnostic
                   let fileUri = diagsNot ^. params . uri
                   case Map.lookup (diagsNot ^. params . uri . to toNormalizedUri) m of
                       Nothing -> do
@@ -103,21 +99,8 @@ expectDiagnostics' messageParser expected = do
                               " but got " <> show actual
                           go $ Map.delete (diagsNot ^. params . uri . to toNormalizedUri) m
 
--- | Matches all diagnostic messages except those from interface loading files
 diagnostic :: Session PublishDiagnosticsNotification
-diagnostic = do
-  m <- LspTest.message
-  let PublishDiagnosticsParams uri diags = _params (m :: PublishDiagnosticsNotification)
-  let diags' = filter (\d -> _source (d:: Diagnostic) /= Just "interface file loading") (toList diags)
-  -- interface loading warnings get sent on a first message,
-  -- followed up by a second message including all other warnings.
-  -- unless the debouncer merges them.
-  -- This can lead to a test matching on the first message and missing
-  -- the interesting warnings.
-  -- Therefore we do not match messages containing only interface loading warnings,
-  -- but, importantly, do match messages containing no warnings.
-  guard (null diags || not (null diags'))
-  return $ (m :: PublishDiagnosticsNotification){_params = PublishDiagnosticsParams uri (List diags')}
+diagnostic = LspTest.message
 
 standardizeQuotes :: T.Text -> T.Text
 standardizeQuotes msg = let