{-# LANGUAGE OverloadedStrings #-}

module FunctionalLiquid (tests) where

import           Control.Lens hiding (List)
import           Control.Monad.IO.Class
import           Data.Aeson
import           Data.Default
import qualified Data.Text as T
import           Language.Haskell.LSP.Test hiding (message)
import           Language.Haskell.LSP.Types as LSP
import           Language.Haskell.LSP.Types.Lens as LSP hiding (contents)
import           Ide.Plugin.Config
import           Test.Hls.Util
import           Test.Tasty
import           Test.Tasty.ExpectedFailure (ignoreTestBecause)
import           Test.Tasty.HUnit

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

tests :: TestTree
tests = testGroup "liquid haskell diagnostics" [
    ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, no liquid" $
        runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
            doc <- openDoc "liquid/Evens.hs" "haskell"

            diags@(reduceDiag:_) <- waitForDiagnostics

            liftIO $ do
                length diags @?= 2
                reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)
                reduceDiag ^. severity @?= Just DsHint
                reduceDiag ^. code @?= Just (StringValue "Use negate")
                reduceDiag ^. source @?= Just "hlint"

            diags2hlint <- waitForDiagnostics

            liftIO $ length diags2hlint @?= 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"

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

    , ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, with liquid haskell" $
        runSession hlsCommand codeActionSupportCaps "test/testdata" $ do
        -- runSessionWithConfig logConfig hlsCommand codeActionSupportCaps "test/testdata" $ do
            doc <- openDoc "liquid/Evens.hs" "haskell"

            diags@(reduceDiag:_) <- waitForDiagnostics

            -- liftIO $ show diags @?= ""

            liftIO $ do
                length diags @?= 2
                reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)
                reduceDiag ^. severity @?= Just DsHint
                reduceDiag ^. code @?= Just (StringValue "Use negate")
                reduceDiag ^. source @?= Just "hlint"

            -- Enable liquid haskell plugin and disable hlint
            let config = def { liquidOn  = True, hlintOn = False }
            sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))

            -- docItem <- getDocItem file languageId
            sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
            -- TODO: what does that test?
            -- TODO: whether hlint is really disbabled?
            -- TODO: @fendor, document or remove
            -- diags2hlint <- waitForDiagnostics
            -- -- liftIO $ show diags2hlint @?= ""

            -- -- We turned hlint diagnostics off
            -- liftIO $ length diags2hlint @?= 0
            -- diags2liquid <- waitForDiagnostics
            -- liftIO $ length diags2liquid @?= 0
            -- liftIO $ show diags2liquid @?= ""
            diags3@(d:_) <- waitForDiagnosticsSource "liquid"
            -- liftIO $ show diags3 @?= ""
            liftIO $ do
                length diags3 @?= 1
                d ^. range @?= Range (Position 8 0) (Position 8 11)
                d ^. severity @?= Just DsError
                d ^. code @?= Nothing
                d ^. source @?= Just "liquid"
                (d ^. message) `T.isPrefixOf`
                    ("Error: Liquid Type Mismatch\n" <>
                     "  Inferred type\n" <>
                     "    VV : {v : GHC.Types.Int | v == 7}\n" <>
                     " \n" <>
                     "  not a subtype of Required type\n" <>
                     "    VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ")
                    @? "Contains error message"
    ]