{-# LANGUAGE OverloadedStrings #-}
module Diagnostic (tests) where
import Control.Applicative.Combinators
import Control.Lens hiding (List)
import Control.Monad.IO.Class
import Data.Aeson (toJSON)
import qualified Data.Default
import Ide.Plugin.Config
import Language.LSP.Test hiding (message)
import Language.LSP.Types
import qualified Language.LSP.Types.Lens as LSP
import Test.Hls.Util
import Test.Tasty
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
import Test.Tasty.HUnit
-- ---------------------------------------------------------------------
tests :: TestTree
tests = testGroup "diagnostics providers" [
basicTests
, saveTests
, warningTests
]
basicTests :: TestTree
basicTests = testGroup "Diagnostics work" [
testCase "hlint produces diagnostics" $
runSession hlsCommand fullCaps "test/testdata/hlint" $ do
doc <- openDoc "ApplyRefact2.hs" "haskell"
diags <- waitForDiagnosticsFromSource doc "hlint"
reduceDiag <- liftIO $ inspectDiagnostic diags ["Eta reduce"]
redundantID <- liftIO $ inspectDiagnostic diags ["Redundant id"]
liftIO $ do
length diags @?= 2
reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12)
reduceDiag ^. LSP.severity @?= Just DsInfo
redundantID ^. LSP.severity @?= Just DsInfo
, testCase "example plugin produces diagnostics" $
runSession hlsCommandExamplePlugin fullCaps "test/testdata/hlint" $ do
doc <- openDoc "ApplyRefact2.hs" "haskell"
diags <- waitForDiagnosticsFromSource doc "example2"
reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]
liftIO $ do
length diags @?= 1
reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
reduceDiag ^. LSP.severity @?= Just DsError
]
warningTests :: TestTree
warningTests = testGroup "Warnings are warnings" [
testCase "Overrides -Werror" $
runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do
doc <- openDoc "src/WError.hs" "haskell"
[diag] <- waitForDiagnosticsFrom doc
liftIO $ diag ^. LSP.severity @?= Just DsWarning
]
saveTests :: TestTree
saveTests = testGroup "only diagnostics on save" [
ignoreTestBecause "diagnosticsOnChange parameter is not supported right now" $ testCase "Respects diagnosticsOnChange setting" $
runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
let config = Data.Default.def { diagnosticsOnChange = False } :: Config
sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
doc <- openDoc "Hover.hs" "haskell"
diags <- waitForDiagnosticsFrom doc
liftIO $ do
length diags @?= 0
let te = TextEdit (Range (Position 0 0) (Position 0 13)) ""
_ <- applyEdit doc te
skipManyTill loggingNotification noDiagnostics
sendNotification STextDocumentDidSave (DidSaveTextDocumentParams doc Nothing)
diags2 <- waitForDiagnosticsFrom doc
liftIO $
length diags2 @?= 1
]