ec0bbd1 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Remove interface loading diagnostics (#579)

ec0bbd1Pepe Iborra6 years ago

exe/Main.hs−1

compare with master

unifiedsplit

@@ -102,7 +102,6 @@ main = do

102 , optShakeProfiling = argsShakeProfiling

103 , optTesting = argsTesting

104 , optThreads = argsThreads

105− , optInterfaceLoadingDiagnostics = argsTesting

106 }

105 }

107 debouncer <- newAsyncDebouncer

106 debouncer <- newAsyncDebouncer

108 initialise caps (cradleRules >> mainRule >> pluginRules plugins >> action kick)

107 initialise caps (cradleRules >> mainRule >> pluginRules plugins >> action kick)

src/Development/IDE/Core/Rules.hs+3−20

@@ -550,36 +550,19 @@ getHiFileRule = defineEarlyCutoff $ \GetHiFile f -> do

550 HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)

551 _ -> ml_hi_file $ ms_location ms

552

553− IdeOptions{optInterfaceLoadingDiagnostics} <- getIdeOptions

554−

555− let mkInterfaceFilesGenerationDiag f intro

556− | optInterfaceLoadingDiagnostics = mkDiag $ intro <> msg

557− | otherwise = []

558− where

559− msg =

560− ": additional resource use while generating interface files in the background."

561− mkDiag = pure

562− . ideErrorWithSource (Just "interface file loading") (Just DsInfo) f

563− . T.pack

564−

565 case sequence depHis of

553 case sequence depHis of

566− Nothing -> do

567− let d = mkInterfaceFilesGenerationDiag f "Missing interface file dependencies"

568− pure (Nothing, (d, Nothing))

554+ Nothing -> pure (Nothing, ([], Nothing))

569 Just deps -> do

555 Just deps -> do

570 gotHiFile <- getFileExists hiFile

556 gotHiFile <- getFileExists hiFile

571 if not gotHiFile

557 if not gotHiFile

572− then do

573− let d = mkInterfaceFilesGenerationDiag f "Missing interface file"

574− pure (Nothing, (d, Nothing))

558+ then pure (Nothing, ([], Nothing))

575 else do

559 else do

576 hiVersion <- use_ GetModificationTime hiFile

560 hiVersion <- use_ GetModificationTime hiFile

577 modVersion <- use_ GetModificationTime f

561 modVersion <- use_ GetModificationTime f

578 let sourceModified = modificationTime hiVersion < modificationTime modVersion

562 let sourceModified = modificationTime hiVersion < modificationTime modVersion

579 if sourceModified

563 if sourceModified

580 then do

564 then do

581− let d = mkInterfaceFilesGenerationDiag f "Stale interface file"

582− pure (Nothing, (d, Nothing))

565+ pure (Nothing, ([], Nothing))

583 else do

566 else do

584 session <- hscEnv <$> use_ GhcSession f

567 session <- hscEnv <$> use_ GhcSession f

585 r <- liftIO $ loadInterface session ms deps

568 r <- liftIO $ loadInterface session ms deps

src/Development/IDE/Types/Options.hs−3

@@ -58,8 +58,6 @@ data IdeOptions = IdeOptions

58 -- features such as diagnostics and go-to-definition, in

59 -- situations in which they would become unavailable because of

60 -- the presence of type errors, holes or unbound variables.

61− , optInterfaceLoadingDiagnostics :: Bool

62− -- ^ Generate Info-level diagnostics to report interface loading actions

63 }

61 }

65data IdePreprocessedSource = IdePreprocessedSource

63data IdePreprocessedSource = IdePreprocessedSource

@@ -93,7 +91,6 @@ defaultIdeOptions session = IdeOptions

93 ,optKeywords = haskellKeywords

91 ,optKeywords = haskellKeywords

94 ,optDefer = IdeDefer True

92 ,optDefer = IdeDefer True

95 ,optTesting = False

93 ,optTesting = False

96− ,optInterfaceLoadingDiagnostics = False

97 }

94 }

test/exe/Main.hs+9−16

@@ -2033,8 +2033,8 @@ cradleTests = testGroup "cradle"

2033

2034loadCradleOnlyonce :: TestTree

2035loadCradleOnlyonce = testGroup "load cradle only once"

2036− [ testSessionTF "implicit" implicit

2036+ [ testSession' "implicit" implicit

2037− , testSessionTF "direct" direct

2037+ , testSession' "direct" direct

2038 ]

2039 where

2040 direct dir = do

@@ -2143,10 +2143,7 @@ testSession :: String -> Session () -> TestTree

2143testSession name = testCase name . run

2144

2145testSession' :: String -> (FilePath -> Session ()) -> TestTree

2146−testSession' name = testCase name . run' NoTestFlag

2146+testSession' name = testCase name . run'

2147−

2148−testSessionTF :: String -> (FilePath -> Session ()) -> TestTree

2149−testSessionTF name = testCase name . run' WithTestFlag

2150

2147

2151testSessionWait :: String -> Session () -> TestTree

2148testSessionWait :: String -> Session () -> TestTree

2152testSessionWait name = testSession name .

2149testSessionWait name = testSession name .

@@ -2177,16 +2174,13 @@ mkRange :: Int -> Int -> Int -> Int -> Range

2177mkRange a b c d = Range (Position a b) (Position c d)

2174mkRange a b c d = Range (Position a b) (Position c d)

2178

2175

2179run :: Session a -> IO a

2176run :: Session a -> IO a

2180−run s = withTempDir $ \dir -> runInDir NoTestFlag dir s

2177+run s = withTempDir $ \dir -> runInDir dir s

2181−

2182−run' :: WithTestFlag -> (FilePath -> Session a) -> IO a

2183−run' tf s = withTempDir $ \dir -> runInDir tf dir (s dir)

2184

2178

2185−-- Do we run the LSP executable with --test or not

2179+run' :: (FilePath -> Session a) -> IO a

2186−data WithTestFlag = WithTestFlag | NoTestFlag deriving (Show, Eq)

2180+run' s = withTempDir $ \dir -> runInDir dir (s dir)

2187

2181

2188−runInDir :: WithTestFlag -> FilePath -> Session a -> IO a

2182+runInDir :: FilePath -> Session a -> IO a

2189−runInDir withTestFlag dir s = do

2183+runInDir dir s = do

2190 ghcideExe <- locateGhcideExecutable

2184 ghcideExe <- locateGhcideExecutable

2191

2185

2192 -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56

2186 -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56

@@ -2199,8 +2193,7 @@ runInDir withTestFlag dir s = do

2199 createDirectoryIfMissing True $ dir </> takeDirectory f

2193 createDirectoryIfMissing True $ dir </> takeDirectory f

2200 copyFile ("test/data" </> f) (dir </> f)

2194 copyFile ("test/data" </> f) (dir </> f)

2201

2195

2202− let cmd = unwords ([ghcideExe, "--lsp", "--cwd", dir]

2196+ let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", dir]

2203− ++ [ "--test" | WithTestFlag == withTestFlag ])

2204 -- HIE calls getXgdDirectory which assumes that HOME is set.

2197 -- HIE calls getXgdDirectory which assumes that HOME is set.

2205 -- Only sets HOME if it wasn't already set.

2198 -- Only sets HOME if it wasn't already set.

2206 setEnv "HOME" "/homeless-shelter" False

2199 setEnv "HOME" "/homeless-shelter" False

test/src/Development/IDE/Test.hs+3−20

@@ -16,7 +16,6 @@ import Control.Applicative.Combinators

16import Control.Lens hiding (List)

17import Control.Monad

18import Control.Monad.IO.Class

19−import Data.Foldable

20import qualified Data.Map.Strict as Map

19import qualified Data.Map.Strict as Map

21import qualified Data.Text as T

20import qualified Data.Text as T

22import Language.Haskell.LSP.Test hiding (message)

21import Language.Haskell.LSP.Test hiding (message)

@@ -74,17 +73,14 @@ expectNoMoreDiagnostics timeout = do

74 ignoreOthers = void anyMessage >> handleMessages

73 ignoreOthers = void anyMessage >> handleMessages

76expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()

75expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()

77−expectDiagnostics = expectDiagnostics' diagnostic

76+expectDiagnostics expected = do

78−

79−expectDiagnostics' :: Session PublishDiagnosticsNotification -> [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()

80−expectDiagnostics' messageParser expected = do

81 expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) (fmap toNormalizedUri . getDocUri) expected

77 expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) (fmap toNormalizedUri . getDocUri) expected

82 go expected'

78 go expected'

83 where

79 where

84 go m

80 go m

85 | Map.null m = pure ()

81 | Map.null m = pure ()

86 | otherwise = do

82 | otherwise = do

87− diagsNot <- skipManyTill anyMessage messageParser

83+ diagsNot <- skipManyTill anyMessage diagnostic

88 let fileUri = diagsNot ^. params . uri

84 let fileUri = diagsNot ^. params . uri

89 case Map.lookup (diagsNot ^. params . uri . to toNormalizedUri) m of

85 case Map.lookup (diagsNot ^. params . uri . to toNormalizedUri) m of

90 Nothing -> do

86 Nothing -> do

@@ -103,21 +99,8 @@ expectDiagnostics' messageParser expected = do

103 " but got " <> show actual

99 " but got " <> show actual

104 go $ Map.delete (diagsNot ^. params . uri . to toNormalizedUri) m

100 go $ Map.delete (diagsNot ^. params . uri . to toNormalizedUri) m

105

101

106−-- | Matches all diagnostic messages except those from interface loading files

107diagnostic :: Session PublishDiagnosticsNotification

102diagnostic :: Session PublishDiagnosticsNotification

108−diagnostic = do

109− m <- LspTest.message

103+diagnostic = LspTest.message

110− let PublishDiagnosticsParams uri diags = _params (m :: PublishDiagnosticsNotification)

111− let diags' = filter (\d -> _source (d:: Diagnostic) /= Just "interface file loading") (toList diags)

112− -- interface loading warnings get sent on a first message,

113− -- followed up by a second message including all other warnings.

114− -- unless the debouncer merges them.

115− -- This can lead to a test matching on the first message and missing

116− -- the interesting warnings.

117− -- Therefore we do not match messages containing only interface loading warnings,

118− -- but, importantly, do match messages containing no warnings.

119− guard (null diags || not (null diags'))

120− return $ (m :: PublishDiagnosticsNotification){_params = PublishDiagnosticsParams uri (List diags')}

121

104

122standardizeQuotes :: T.Text -> T.Text

105standardizeQuotes :: T.Text -> T.Text

123standardizeQuotes msg = let

106standardizeQuotes msg = let