{-# LANGUAGE GADTs #-}
module DiagnosticTests (tests) where
import Control.Applicative.Combinators
import qualified Control.Lens as Lens
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List.Extra
import qualified Data.Text as T
import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion)
import Development.IDE.GHC.Util
import Development.IDE.Test (diagnostic,
expectCurrentDiagnostics,
expectDiagnostics,
expectDiagnosticsWithTags,
expectNoMoreDiagnostics,
flushMessages, waitForAction)
import Development.IDE.Types.Location
import qualified Language.LSP.Protocol.Lens as L
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types hiding
(SemanticTokenAbsolute (..),
SemanticTokenRelative (..),
SemanticTokensEdit (..),
mkRange)
import Language.LSP.Test
import System.Directory
import System.FilePath
import System.IO.Extra hiding (withTempDir)
import Config
import Control.Lens ((^.))
import Control.Monad.Extra (whenJust)
import Data.Default (def)
import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))
import System.Time.Extra
import Test.Hls (TestConfig (testConfigCaps, testDirLocation, testDisableKick, testPluginDescriptor),
runSessionWithTestConfig,
waitForProgressBegin)
import Test.Hls.FileSystem (directCradle, file, text)
import Test.Tasty
import Test.Tasty.HUnit
tests :: TestTree
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")])]
let change = TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
{ _range = Range (Position 0 15) (Position 0 19)
, _rangeLength = Nothing
, _text = "where"
}
changeDoc doc [change]
expectDiagnostics [("Testing.hs", [])]
, testWithDummyPluginEmpty "introduce syntax error" $ do
let content = T.unlines [ "module Testing where" ]
doc <- createDoc "Testing.hs" "haskell" content
void $ skipManyTill anyMessage (message SMethod_WindowWorkDoneProgressCreate)
waitForProgressBegin
let change = TextDocumentContentChangeEvent$ InL TextDocumentContentChangePartial
{ _range = Range (Position 0 15) (Position 0 18)
, _rangeLength = Nothing
, _text = "wher"
}
changeDoc doc [change]
expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error")])]
, 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'")])]
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'")])]
, testWithDummyPluginEmpty "variable not in scope" $ do
let content = T.unlines
[ "module Testing where"
, "foo :: Int -> Int -> Int"
, "foo a _b = a + ab"
, "bar :: Int -> Int -> Int"
, "bar _a b = cd + b"
]
_ <- 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")
]
)
]
, testWithDummyPluginEmpty "type error" $ do
let content = T.unlines
[ "module Testing where"
, "foo :: Int -> String -> Int"
, "foo a b = a + b"
]
_ <- createDoc "Testing.hs" "haskell" content
expectDiagnostics
[ ( "Testing.hs"
, [(DiagnosticSeverity_Error, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
)
]
, testWithDummyPluginEmpty "typed hole" $ do
let content = T.unlines
[ "module Testing where"
, "foo :: Int -> String"
, "foo a = _ a"
]
_ <- createDoc "Testing.hs" "haskell" content
expectDiagnostics
[ ( "Testing.hs"
, [(DiagnosticSeverity_Error, (2, 8), "Found hole: _ :: Int -> String")]
)
]
, testGroup "deferral" $
let sourceA a = T.unlines
[ "module A where"
, "a :: Int"
, "a = " <> a]
sourceB = T.unlines
[ "module B where"
, "import A ()"
, "b :: Float"
, "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)])]
deferralTest title binding msg = testWithDummyPluginEmpty title $ do
_ <- createDoc "A.hs" "haskell" $ sourceA binding
_ <- createDoc "B.hs" "haskell" sourceB
expectDiagnostics $ expectedDs msg
in
[ deferralTest "type error" "True" "Couldn't match expected type"
, deferralTest "typed hole" "_" "Found hole"
, deferralTest "out of scope var" "unbound" "Variable not in scope"
]
, testWithDummyPluginEmpty "remove required module" $ do
let contentA = T.unlines [ "module ModuleA where" ]
docA <- createDoc "ModuleA.hs" "haskell" contentA
let contentB = T.unlines
[ "module ModuleB where"
, "import ModuleA"
]
_ <- createDoc "ModuleB.hs" "haskell" contentB
let change = TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
{ _range = Range (Position 0 0) (Position 0 20)
, _rangeLength = Nothing
, _text = ""
}
changeDoc docA [change]
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 0), "Could not find module")])]
, 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")])]
let contentA = T.unlines [ "module ModuleA where" ]
_ <- createDoc "ModuleA.hs" "haskell" contentA
expectDiagnostics [("ModuleB.hs", [])]
, testCase "add missing module (non workspace)" $
runSessionWithTestConfig def
{ testPluginDescriptor = dummyPlugin
, testConfigCaps = lspTestCapsNoFileWatches
, testDirLocation = Right (mkIdeTestFs [])
}
$ \tmpDir -> do
-- By default lsp-test sends FileWatched notifications for all files, which we don't want
-- as non workspace modules will not be watched by the LSP server.
-- To work around this, we tell lsp-test that our client doesn't have the
-- FileWatched capability, which is enough to disable the notifications
let contentB = T.unlines
[ "module ModuleB where"
, "import ModuleA ()"
]
_ <- createDoc (tmpDir </> "ModuleB.hs") "haskell" contentB
expectDiagnostics [(tmpDir </> "ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module")])]
let contentA = T.unlines [ "module ModuleA where" ]
_ <- createDoc (tmpDir </> "ModuleA.hs") "haskell" contentA
expectDiagnostics [(tmpDir </> "ModuleB.hs", [])]
, testWithDummyPluginEmpty "cyclic module dependency" $ do
let contentA = T.unlines
[ "module ModuleA where"
, "import ModuleB"
]
let contentB = T.unlines
[ "module ModuleB where"
, "import ModuleA"
]
_ <- createDoc "ModuleA.hs" "haskell" contentA
_ <- createDoc "ModuleB.hs" "haskell" contentB
expectDiagnostics
[ ( "ModuleA.hs"
, [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
)
, ( "ModuleB.hs"
, [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
)
]
, let contentA = T.unlines [ "module ModuleA where" , "import ModuleB" ]
contentB = T.unlines [ "module ModuleB where" , "import ModuleA" ]
contentC = T.unlines [ "module ModuleC where" , "import ModuleB" ]
contentD = T.unlines [ "module ModuleD where" , "import ModuleC" ]
cradle = directCradle ["ModuleA", "ModuleB", "ModuleC", "ModuleD"]
in testWithDummyPlugin "deeply nested cyclic module dependency"
(mkIdeTestFs [
file "ModuleA.hs" (text contentA)
,file "ModuleB.hs" (text contentB)
,file "ModuleC.hs" (text contentC)
,cradle
]) $ 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")])
]
, testWithDummyPluginEmpty "cyclic module dependency with hs-boot" $ do
let contentA = T.unlines
[ "module ModuleA where"
, "import {-# SOURCE #-} ModuleB"
]
let contentB = T.unlines
[ "{-# OPTIONS -Wmissing-signatures#-}"
, "module ModuleB where"
, "import ModuleA"
-- introduce an artificial diagnostic
, "foo = ()"
]
let contentBboot = T.unlines
[ "module ModuleB where"
]
_ <- 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")])]
, testWithDummyPlugin "bidirectional module dependency with hs-boot"
(mkIdeTestFs [directCradle ["ModuleA", "ModuleB"]])
$ do
let contentA = T.unlines
[ "module ModuleA where"
, "import {-# SOURCE #-} ModuleB"
]
let contentB = T.unlines
[ "{-# OPTIONS -Wmissing-signatures#-}"
, "module ModuleB where"
, "import {-# SOURCE #-} ModuleA"
-- introduce an artificial diagnostic
, "foo = ()"
]
let contentBboot = T.unlines
[ "module ModuleB where"
]
let contentAboot = T.unlines
[ "module ModuleA where"
]
_ <- createDoc "ModuleA.hs" "haskell" contentA
_ <- 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")])]
, testWithDummyPluginEmpty "correct reference used with hs-boot" $ do
let contentB = T.unlines
[ "module ModuleB where"
, "import {-# SOURCE #-} ModuleA()"
]
let contentA = T.unlines
[ "module ModuleA where"
, "import ModuleB()"
, "x = 5"
]
let contentAboot = T.unlines
[ "module ModuleA where"
]
let contentC = T.unlines
[ "{-# OPTIONS -Wmissing-signatures #-}"
, "module ModuleC where"
, "import ModuleA"
-- this reference will fail if it gets incorrectly
-- resolved to the hs-boot file
, "y = x"
]
_ <- createDoc "ModuleB.hs" "haskell" contentB
_ <- 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")])]
, testWithDummyPluginEmpty "redundant import" $ do
let contentA = T.unlines ["module ModuleA where"]
let contentB = T.unlines
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "import ModuleA"
]
_ <- createDoc "ModuleA.hs" "haskell" contentA
_ <- createDoc "ModuleB.hs" "haskell" contentB
expectDiagnosticsWithTags
[ ( "ModuleB.hs"
, [(DiagnosticSeverity_Warning, (2, 0), "The import of 'ModuleA' is redundant", Just DiagnosticTag_Unnecessary)]
)
]
, testWithDummyPluginEmpty "redundant import even without warning" $ do
let contentA = T.unlines ["module ModuleA where"]
let contentB = T.unlines
[ "{-# OPTIONS_GHC -Wno-unused-imports -Wmissing-signatures #-}"
, "module ModuleB where"
, "import ModuleA"
-- introduce an artificial warning for testing purposes
, "foo = ()"
]
_ <- createDoc "ModuleA.hs" "haskell" contentA
_ <- createDoc "ModuleB.hs" "haskell" contentB
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
, testWithDummyPluginEmpty "package imports" $ do
let thisDataListContent = T.unlines
[ "module Data.List where"
, "x :: Integer"
, "x = 123"
]
let mainContent = T.unlines
[ "{-# LANGUAGE PackageImports #-}"
, "module Main where"
, "import qualified \"this\" Data.List as ThisList"
, "import qualified \"base\" Data.List as BaseList"
, "useThis = ThisList.x"
, "useBase = BaseList.map"
, "wrong1 = ThisList.map"
, "wrong2 = BaseList.x"
, "main = pure ()"
]
_ <- createDoc "Data/List.hs" "haskell" thisDataListContent
_ <- createDoc "Main.hs" "haskell" mainContent
expectDiagnostics
[ ( "Main.hs"
, [(DiagnosticSeverity_Error, (6, 9),
if ghcVersion >= GHC96 then
"Variable not in scope: ThisList.map"
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")
,(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")
]
)
]
, testWithDummyPluginEmpty "unqualified warnings" $ do
let fooContent = T.unlines
[ "{-# OPTIONS_GHC -Wredundant-constraints #-}"
, "module Foo where"
, "foo :: Ord a => a -> Int"
, "foo _a = 1"
]
_ <- createDoc "Foo.hs" "haskell" fooContent
expectDiagnostics
[ ( "Foo.hs"
-- The test is to make sure that warnings contain unqualified names
-- 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")
]
)
]
, testWithDummyPluginEmpty "lower-case drive" $ do
let aContent = T.unlines
[ "module A.A where"
, "import A.B ()"
]
bContent = T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, "module A.B where"
, "import Data.List"
]
uriB <- getDocUri "A/B.hs"
Just pathB <- pure $ uriToFilePath uriB
uriB <- pure $
let (drive, suffix) = splitDrive pathB
in filePathToUri (joinDrive (lower drive) suffix)
liftIO $ createDirectoryIfMissing True (takeDirectory pathB)
liftIO $ writeFileUTF8 pathB $ T.unpack bContent
uriA <- getDocUri "A/A.hs"
Just pathA <- pure $ uriToFilePath uriA
uriA <- pure $
let (drive, suffix) = splitDrive pathA
in filePathToUri (joinDrive (lower drive) suffix)
let itemA = TextDocumentItem uriA "haskell" 0 aContent
let a = TextDocumentIdentifier uriA
sendNotification SMethod_TextDocumentDidOpen (DidOpenTextDocumentParams itemA)
TNotificationMessage{_params = PublishDiagnosticsParams fileUri _ diags} <- skipManyTill anyMessage diagnostic
-- Check that if we put a lower-case drive in for A.A
-- the diagnostics for A.B will also be lower-case.
liftIO $ fileUri @?= uriB
let msg :: T.Text = head diags ^. L.message
liftIO $ unless ("redundant" `T.isInfixOf` msg) $
assertFailure ("Expected redundant import but got " <> T.unpack msg)
closeDoc a
, testWithDummyPluginEmpty "strip file path" $ do
let
name = "Testing"
content = T.unlines
[ "module " <> name <> " where"
, "value :: Maybe ()"
, "value = [()]"
]
_ <- createDoc (T.unpack name <> ".hs") "haskell" content
notification <- skipManyTill anyMessage diagnostic
let
offenders =
L.params .
L.diagnostics .
Lens.folded .
L.message .
Lens.filtered (T.isInfixOf ("/" <> name <> ".hs:"))
failure msg = liftIO $ assertFailure $ "Expected file path to be stripped but got " <> T.unpack msg
Lens.mapMOf_ offenders failure notification
, testWithDummyPlugin "-Werror in cradle is ignored"
(mkIdeTestFs [directCradle ["-Wall", "-Werror"]])
$ do
let fooContent = T.unlines
[ "module Foo where"
, "foo = ()"
]
_ <- createDoc "Foo.hs" "haskell" fooContent
expectDiagnostics
[ ( "Foo.hs"
, [(DiagnosticSeverity_Warning, (1, 0), "Top-level binding with no type signature:")
]
)
]
, testWithDummyPluginEmpty "-Werror in pragma is ignored" $ do
let fooContent = T.unlines
[ "{-# OPTIONS_GHC -Wall -Werror #-}"
, "module Foo() where"
, "foo :: Int"
, "foo = 1"
]
_ <- createDoc "Foo.hs" "haskell" fooContent
expectDiagnostics
[ ( "Foo.hs"
, [(DiagnosticSeverity_Warning, (3, 0), "Defined but not used:")
]
)
]
, testCase "typecheck-all-parents-of-interest" $ runWithExtraFiles "recomp" $ \dir -> do
let bPath = dir </> "B.hs"
pPath = dir </> "P.hs"
aPath = dir </> "A.hs"
bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int
aSource <- liftIO $ readFileUtf8 aPath -- x = y :: Int
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
-- 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'")])
]
-- Open A and edit to fix the type error
adoc <- createDoc aPath "haskell" aSource
changeDoc adoc [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $
T.unlines ["module A where", "import B", "x :: Bool", "x = y"]]
expectDiagnostics
[ ( "P.hs",
[ (DiagnosticSeverity_Error, (4, 6), "Couldn't match expected type 'Int' with actual type 'Bool'"),
(DiagnosticSeverity_Warning, (4, 0), "Top-level binding")
]
),
("A.hs", [])
]
expectNoMoreDiagnostics 1
, 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'")])]
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'")])]
, testGroup "Cancellation"
[ cancellationTestGroup "edit header" editHeader yesSession noParse noTc
, cancellationTestGroup "edit import" editImport noSession yesParse noTc
, cancellationTestGroup "edit body" editBody yesSession yesParse yesTc
]
]
where
editPair x y = let p = Position x y ; p' = Position x (y+2) in
(TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
{ _range = Range p p
, _rangeLength = Nothing
, _text = "fd"
}
,TextDocumentContentChangeEvent $ InL TextDocumentContentChangePartial
{ _range = Range p p'
, _rangeLength = Nothing
, _text = ""
}
)
editHeader = editPair 0 0
editImport = editPair 2 10
editBody = editPair 3 10
noParse = False
yesParse = True
noSession = False
yesSession = True
noTc = False
yesTc = True
cancellationTestGroup :: TestName -> (TextDocumentContentChangeEvent, TextDocumentContentChangeEvent) -> Bool -> Bool -> Bool -> TestTree
cancellationTestGroup name edits sessionDepsOutcome parseOutcome tcOutcome = testGroup name
[ cancellationTemplate edits Nothing
, cancellationTemplate edits $ Just ("GetFileContents", True)
, cancellationTemplate edits $ Just ("GhcSession", True)
-- the outcome for GetModSummary is always True because parseModuleHeader never fails (!)
, cancellationTemplate edits $ Just ("GetModSummary", True)
, cancellationTemplate edits $ Just ("GetModSummaryWithoutTimestamps", True)
-- getLocatedImports never fails
, cancellationTemplate edits $ Just ("GetLocatedImports", True)
, cancellationTemplate edits $ Just ("GhcSessionDeps", sessionDepsOutcome)
, cancellationTemplate edits $ Just ("GetParsedModule", parseOutcome)
, cancellationTemplate edits $ Just ("TypeCheck", tcOutcome)
, cancellationTemplate edits $ Just ("GetHieAst", tcOutcome)
]
cancellationTemplate :: (TextDocumentContentChangeEvent, TextDocumentContentChangeEvent) -> Maybe (String, Bool) -> TestTree
cancellationTemplate (edit, undoEdit) mbKey = testCase (maybe "-" fst mbKey) $ runTestNoKick $ do
doc <- createDoc "Foo.hs" "haskell" $ T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, "module Foo where"
, "import Data.List()"
, "f0 x = (x,x)"
]
-- for the example above we expect one warning
let missingSigDiags = [(DiagnosticSeverity_Warning, (3, 0), "Top-level binding") ]
typeCheck doc >> expectCurrentDiagnostics doc missingSigDiags
-- Now we edit the document and wait for the given key (if any)
changeDoc doc [edit]
whenJust mbKey $ \(key, expectedResult) -> do
WaitForIdeRuleResult{ideResultSuccess} <- waitForAction key doc
liftIO $ ideResultSuccess @?= expectedResult
-- The 2nd edit cancels the active session and unbreaks the file
-- wait for typecheck and check that the current diagnostics are accurate
changeDoc doc [undoEdit]
typeCheck doc >> expectCurrentDiagnostics doc missingSigDiags
expectNoMoreDiagnostics 0.5
where
runTestNoKick s =
runSessionWithTestConfig def
{ testPluginDescriptor = dummyPlugin
, testDirLocation = Right (mkIdeTestFs [])
, testDisableKick = True
} $ const s
typeCheck doc = do
WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" doc
liftIO $ assertBool "The file should typecheck" ideResultSuccess
-- wait for the debouncer to publish diagnostics if the rule runs
liftIO $ sleep 0.2
-- flush messages to ensure current diagnostics state is updated
flushMessages