mirror of
https://github.com/haskell/ghcide.git
synced 2024-10-26 05:58:45 +03:00
Remove interface loading diagnostics (#579)
* Drop interface loading diagnostics * No reason to skip the --test flag anymore
This commit is contained in:
parent
e16e841fa7
commit
ec0bbd1b1d
@ -102,7 +102,6 @@ main = do
|
||||
, optShakeProfiling = argsShakeProfiling
|
||||
, optTesting = argsTesting
|
||||
, optThreads = argsThreads
|
||||
, optInterfaceLoadingDiagnostics = argsTesting
|
||||
}
|
||||
debouncer <- newAsyncDebouncer
|
||||
initialise caps (cradleRules >> mainRule >> pluginRules plugins >> action kick)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
||||
|
@ -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 s = withTempDir $ \dir -> runInDir dir s
|
||||
|
||||
run' :: WithTestFlag -> (FilePath -> Session a) -> IO a
|
||||
run' tf s = withTempDir $ \dir -> runInDir tf dir (s dir)
|
||||
run' :: (FilePath -> Session a) -> IO a
|
||||
run' s = withTempDir $ \dir -> runInDir dir (s dir)
|
||||
|
||||
-- Do we run the LSP executable with --test or not
|
||||
data WithTestFlag = WithTestFlag | NoTestFlag deriving (Show, Eq)
|
||||
|
||||
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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user