{-# LANGUAGE OverloadedStrings #-}

module Diagnostic (tests) where

import           Control.Lens            hiding (List)
import           Data.Aeson              (toJSON)
import qualified Data.Default
import           Ide.Plugin.Config
import qualified Language.LSP.Types.Lens as LSP
import           Test.Hls
import           Test.Hls.Command

-- ---------------------------------------------------------------------

tests :: TestTree
tests = testGroup "diagnostics providers" [
        basicTests
        , saveTests
        , warningTests
    ]

basicTests :: TestTree
basicTests = testGroup "Diagnostics work" [
    testCase "example plugin produces diagnostics" $
        runSession hlsCommandExamplePlugin fullCaps "test/testdata/diagnostics" $ do
            doc <- openDoc "Foo.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
            sendConfigurationChanged (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
    ]