Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 7cd1ab8

Browse files
committed
Setting the diagnosticsOnChange default to True
1 parent c54efd3 commit 7cd1ab8

File tree

3 files changed

+39
-22
lines changed

3 files changed

+39
-22
lines changed

hie-plugin-api/Haskell/Ide/Engine/Config.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ data Config =
3333
instance Default Config where
3434
def = Config
3535
{ hlintOn = True
36-
, diagnosticsOnChange = False
36+
, diagnosticsOnChange = True
3737
, maxNumberOfProblems = 100
3838
, diagnosticsDebounceDuration = 350000
3939
, liquidOn = False

test/functional/DiagnosticsSpec.hs

Lines changed: 36 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,14 @@ module DiagnosticsSpec where
44

55
import Control.Lens hiding (List)
66
import Control.Monad.IO.Class
7+
import Data.Aeson (toJSON)
78
import qualified Data.Text as T
9+
import qualified Data.Default
810
import Haskell.Ide.Engine.MonadFunctions
11+
import Haskell.Ide.Engine.Config
912
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
1215
import Test.Hspec
1316
import TestUtils
1417
import Utils
@@ -30,10 +33,10 @@ spec = describe "diagnostics providers" $ do
3033

3134
liftIO $ do
3235
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"
3740

3841
diags2a <- waitForDiagnostics
3942
-- liftIO $ show diags2a `shouldBe` ""
@@ -51,24 +54,44 @@ spec = describe "diagnostics providers" $ do
5154
-- liftIO $ show diags3 `shouldBe` ""
5255
liftIO $ do
5356
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"
5962

6063
describe "typed hole errors" $
6164
it "is deferred" $
6265
runSession hieCommand fullCaps "test/testdata" $ do
6366
_ <- openDoc "TypedHoles.hs" "haskell"
6467
[diag] <- waitForDiagnosticsSource "ghcmod"
65-
liftIO $ diag ^. severity `shouldBe` Just DsWarning
68+
liftIO $ diag ^. LSP.severity `shouldBe` Just DsWarning
6669

6770
describe "Warnings are warnings" $
6871
it "Overrides -Werror" $
6972
runSession hieCommand fullCaps "test/testdata/wErrorTest" $ do
7073
_ <- openDoc "src/WError.hs" "haskell"
7174
[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
7396

7497
-- ---------------------------------------------------------------------

test/functional/FunctionalCodeActionsSpec.hs

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -20,16 +20,10 @@ import qualified Language.Haskell.LSP.Types.Capabilities as C
2020
import Test.Hspec
2121
import TestUtils
2222

23-
runSessionWithOnChange :: String -> C.ClientCapabilities -> FilePath -> Session a -> IO a
24-
runSessionWithOnChange cmd caps name test = runSession cmd caps name $ do
25-
let config = def { diagnosticsOnChange = True }
26-
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
27-
test
28-
2923
spec :: Spec
3024
spec = describe "code actions" $ do
3125
describe "hlint suggestions" $ do
32-
it "provides 3.8 code actions" $ runSessionWithOnChange hieCommand fullCaps "test/testdata" $ do
26+
it "provides 3.8 code actions" $ runSession hieCommand fullCaps "test/testdata" $ do
3327

3428
doc <- openDoc "ApplyRefact2.hs" "haskell"
3529
diags@(reduceDiag:_) <- waitForDiagnostics
@@ -55,7 +49,7 @@ spec = describe "code actions" $ do
5549

5650
-- ---------------------------------
5751

58-
it "falls back to pre 3.8 code actions" $ runSessionWithOnChange hieCommand noLiteralCaps "test/testdata" $ do
52+
it "falls back to pre 3.8 code actions" $ runSession hieCommand noLiteralCaps "test/testdata" $ do
5953
doc <- openDoc "ApplyRefact2.hs" "haskell"
6054

6155
_ <- waitForDiagnostics

0 commit comments

Comments
 (0)