@@ -4,11 +4,14 @@ module DiagnosticsSpec where
4
4
5
5
import Control.Lens hiding (List )
6
6
import Control.Monad.IO.Class
7
+ import Data.Aeson (toJSON )
7
8
import qualified Data.Text as T
9
+ import qualified Data.Default
8
10
import Haskell.Ide.Engine.MonadFunctions
11
+ import Haskell.Ide.Engine.Config
9
12
import Language.Haskell.LSP.Test hiding (message )
10
- import Language.Haskell.LSP.Types as LSP
11
- import Language.Haskell.LSP.Types.Lens as LSP hiding ( contents , error )
13
+ import Language.Haskell.LSP.Types
14
+ import qualified Language.Haskell.LSP.Types.Lens as LSP
12
15
import Test.Hspec
13
16
import TestUtils
14
17
import Utils
@@ -30,10 +33,10 @@ spec = describe "diagnostics providers" $ do
30
33
31
34
liftIO $ do
32
35
length diags `shouldBe` 2
33
- reduceDiag ^. range `shouldBe` Range (Position 1 0 ) (Position 1 12 )
34
- reduceDiag ^. severity `shouldBe` Just DsInfo
35
- reduceDiag ^. code `shouldBe` Just " Eta reduce"
36
- reduceDiag ^. source `shouldBe` Just " hlint"
36
+ reduceDiag ^. LSP. range `shouldBe` Range (Position 1 0 ) (Position 1 12 )
37
+ reduceDiag ^. LSP. severity `shouldBe` Just DsInfo
38
+ reduceDiag ^. LSP. code `shouldBe` Just " Eta reduce"
39
+ reduceDiag ^. LSP. source `shouldBe` Just " hlint"
37
40
38
41
diags2a <- waitForDiagnostics
39
42
-- liftIO $ show diags2a `shouldBe` ""
@@ -51,24 +54,44 @@ spec = describe "diagnostics providers" $ do
51
54
-- liftIO $ show diags3 `shouldBe` ""
52
55
liftIO $ do
53
56
length diags3 `shouldBe` 3
54
- d ^. range `shouldBe` Range (Position 0 0 ) (Position 1 0 )
55
- d ^. severity `shouldBe` Nothing
56
- d ^. code `shouldBe` Nothing
57
- d ^. source `shouldBe` Just " eg2"
58
- d ^. message `shouldBe` T. pack " Example plugin diagnostic, triggered byDiagnosticOnSave"
57
+ d ^. LSP. range `shouldBe` Range (Position 0 0 ) (Position 1 0 )
58
+ d ^. LSP. severity `shouldBe` Nothing
59
+ d ^. LSP. code `shouldBe` Nothing
60
+ d ^. LSP. source `shouldBe` Just " eg2"
61
+ d ^. LSP. message `shouldBe` T. pack " Example plugin diagnostic, triggered byDiagnosticOnSave"
59
62
60
63
describe " typed hole errors" $
61
64
it " is deferred" $
62
65
runSession hieCommand fullCaps " test/testdata" $ do
63
66
_ <- openDoc " TypedHoles.hs" " haskell"
64
67
[diag] <- waitForDiagnosticsSource " ghcmod"
65
- liftIO $ diag ^. severity `shouldBe` Just DsWarning
68
+ liftIO $ diag ^. LSP. severity `shouldBe` Just DsWarning
66
69
67
70
describe " Warnings are warnings" $
68
71
it " Overrides -Werror" $
69
72
runSession hieCommand fullCaps " test/testdata/wErrorTest" $ do
70
73
_ <- openDoc " src/WError.hs" " haskell"
71
74
[diag] <- waitForDiagnosticsSource " ghcmod"
72
- liftIO $ diag ^. severity `shouldBe` Just DsWarning
75
+ liftIO $ diag ^. LSP. severity `shouldBe` Just DsWarning
76
+
77
+ describe " only diagnostics on save" $
78
+ it " Respects diagnosticsOnChange setting" $
79
+ runSession hieCommandExamplePlugin codeActionSupportCaps " test/testdata" $ do
80
+ let config = Data.Default. def { diagnosticsOnChange = False } :: Config
81
+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
82
+ doc <- openDoc " Hover.hs" " haskell"
83
+ diags <- waitForDiagnostics
84
+
85
+ liftIO $ do
86
+ length diags `shouldBe` 0
87
+
88
+ let te = TextEdit (Range (Position 0 0 ) (Position 0 13 )) " "
89
+ _ <- applyEdit doc te
90
+ noDiagnostics
91
+
92
+ sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
93
+ diags2 <- waitForDiagnostics
94
+ liftIO $
95
+ length diags2 `shouldBe` 1
73
96
74
97
-- ---------------------------------------------------------------------
0 commit comments