{-# 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.Text as T
import qualified Data.Default
import Ide.Logger
import Ide.Plugin.Config
import Language.Haskell.LSP.Test hiding (message)
import Language.Haskell.LSP.Types
import qualified Language.Haskell.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" [
saveTests
, triggerTests
, errorTests
, warningTests
]
triggerTests :: TestTree
triggerTests = testGroup "diagnostics triggers" [
ignoreTestBecause "Broken" $
ignoreTestBecause "Broken" $ testCase "runs diagnostics on save" $
runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
logm "starting DiagnosticSpec.runs diagnostic on save"
doc <- openDoc "ApplyRefact2.hs" "haskell"
diags@(reduceDiag:_) <- waitForDiagnostics
liftIO $ do
length diags @?= 2
reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12)
reduceDiag ^. LSP.severity @?= Just DsInfo
reduceDiag ^. LSP.code @?= Just (StringValue "Eta reduce")
reduceDiag ^. LSP.source @?= Just "hlint"
diags2a <- waitForDiagnostics
liftIO $ length diags2a @?= 2
sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
diags3@(d:_) <- waitForDiagnosticsSource "eg2"
liftIO $ do
length diags3 @?= 1
d ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
d ^. LSP.severity @?= Nothing
d ^. LSP.code @?= Nothing
d ^. LSP.message @?= T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave"
]
errorTests :: TestTree
errorTests = testGroup "typed hole errors" [
ignoreTestBecause "Broken" $ testCase "is deferred" $
runSession hlsCommand fullCaps "test/testdata" $ do
_ <- openDoc "TypedHoles.hs" "haskell"
[diag] <- waitForDiagnosticsSource "bios"
liftIO $ diag ^. LSP.severity @?= Just DsWarning
]
warningTests :: TestTree
warningTests = testGroup "Warnings are warnings" [
ignoreTestBecause "Broken" $ testCase "Overrides -Werror" $
runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do
_ <- openDoc "src/WError.hs" "haskell"
[diag] <- waitForDiagnosticsSource "bios"
liftIO $ diag ^. LSP.severity @?= Just DsWarning
]
saveTests :: TestTree
saveTests = testGroup "only diagnostics on save" [
ignoreTestBecause "Broken" $ testCase "Respects diagnosticsOnChange setting" $
runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
let config = Data.Default.def { diagnosticsOnChange = False } :: Config
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
doc <- openDoc "Hover.hs" "haskell"
diags <- waitForDiagnostics
liftIO $ do
length diags @?= 0
let te = TextEdit (Range (Position 0 0) (Position 0 13)) ""
_ <- applyEdit doc te
skipManyTill loggingNotification noDiagnostics
sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
diags2 <- waitForDiagnostics
liftIO $
length diags2 @?= 1
]