{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeFamilies      #-}

module Config (tests) where

import           Control.DeepSeq
import           Control.Lens            hiding (List, (.=))
import           Control.Monad
import           Data.Aeson
import           Data.Hashable
import qualified Data.HashMap.Strict     as HM
import qualified Data.Map                as Map
import qualified Data.Text               as T
import           Data.Typeable           (Typeable)
import           Development.IDE         (RuleResult, action, define,
                                          getFilesOfInterestUntracked,
                                          getPluginConfigAction, ideErrorText,
                                          uses_)
import           Development.IDE.Test    (expectDiagnostics)
import           GHC.Generics
import           Ide.Plugin.Config
import           Ide.Types
import           Language.LSP.Test       as Test
import qualified Language.LSP.Types.Lens as L
import           System.FilePath         ((</>))
import           Test.Hls
import           Test.Hls.Command

{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}

tests :: TestTree
tests = testGroup "plugin config" [
      -- Note: there are more comprehensive tests over config in hls-hlint-plugin
      -- TODO: Add generic tests over some example plugin
      configParsingTests, genericConfigTests
    ]

configParsingTests :: TestTree
configParsingTests = testGroup "config parsing"
    [ testCase "empty object as user configuration should not send error logMessage" $ runConfigSession "" $ do
        let config = object []
        sendConfigurationChanged (toJSON config)

        -- Send custom request so server returns a response to prevent blocking
        void $ sendNotification (SCustomMethod "non-existent-method") Null

        logNot <- skipManyTill Test.anyMessage (message SWindowLogMessage)

        liftIO $ (logNot ^. L.params . L.xtype) > MtError
                 || "non-existent-method" `T.isInfixOf` (logNot ^. L.params . L.message)
                    @? "Server sends logMessage with MessageType = Error"
    ]

    where
        runConfigSession :: FilePath -> Session a -> IO a
        runConfigSession subdir  =
            failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata" </> subdir)

genericConfigTests :: TestTree
genericConfigTests = testGroup "generic plugin config"
    [
        testCase "custom defaults" $ runConfigSession "diagnostics" $ do
            _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False"
            -- getting only the standard diagnostics means the plugin wasn't enabled
            expectDiagnostics standardDiagnostics
   ,    testCase "custom defaults and user config on some other plugin" $ runConfigSession "diagnostics" $ do
            _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False"
            -- test that the user config doesn't accidentally override the initial config
            sendConfigurationChanged $ toJSON (changeConfig "someplugin" def{plcHoverOn = False})
            -- getting only the expected diagnostics means the plugin wasn't enabled
            expectDiagnostics standardDiagnostics
    ,   expectFailBecause "partial config is not supported" $
        testCase "custom defaults and non overlapping user config" $ runConfigSession "diagnostics" $ do
            _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False"
            -- test that the user config doesn't accidentally override the initial config
            sendConfigurationChanged $ toJSON (changeConfig testPluginId def{plcHoverOn = False})
            -- getting only the expected diagnostics means the plugin wasn't enabled
            expectDiagnostics standardDiagnostics
    ,   testCase "custom defaults and overlapping user plugin config" $ runConfigSession "diagnostics" $ do
            _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False"
            -- test that the user config overrides the default initial config
            sendConfigurationChanged $ toJSON (changeConfig testPluginId def{plcGlobalOn = True})
            -- getting only the expected diagnostics means the plugin wasn't enabled
            expectDiagnostics testPluginDiagnostics
    ,   testCase "custom defaults and non plugin user config" $ runConfigSession "diagnostics" $ do
            _doc <- createDoc "Foo.hs" "haskell" "module Foo where\nfoo = False"
            -- test that the user config doesn't accidentally override the initial config
            sendConfigurationChanged $ toJSON (def {formattingProvider = "foo"})
            -- getting only the expected diagnostics means the plugin wasn't enabled
            expectDiagnostics standardDiagnostics
    ]
    where
        standardDiagnostics = [("Foo.hs", [(DsWarning, (1,0), "Top-level binding")])]
        testPluginDiagnostics = [("Foo.hs", [(DsError, (0,0), "testplugin")])]

        runConfigSession subdir =
            failIfSessionTimeout . runSessionWithServer @() plugin ("test/testdata" </> subdir)

        testPluginId = "testplugin"
        -- A disabled-by-default plugin that creates diagnostics
        plugin = mkPluginTestDescriptor' pd testPluginId
        pd plId = (defaultPluginDescriptor plId)
          {
            pluginConfigDescriptor = configDisabled
          , pluginRules = do
              action $ do
                plc <- getPluginConfigAction testPluginId
                when (plcGlobalOn plc && plcDiagnosticsOn plc) $ do
                    files <- getFilesOfInterestUntracked
                    void $ uses_ GetTestDiagnostics $ HM.keys files
              define mempty $ \GetTestDiagnostics file -> do
                let diags = [ideErrorText file "testplugin"]
                return (diags,Nothing)
          }
        -- A config that disables the plugin initially
        configDisabled = defaultConfigDescriptor{
            configInitialGenericConfig = def{plcGlobalOn = False, plcDiagnosticsOn = False}
        }
        changeConfig :: PluginId -> PluginConfig -> Config
        changeConfig plugin conf =
            def{plugins = Map.fromList [(plugin, conf)]}


data GetTestDiagnostics = GetTestDiagnostics
    deriving (Eq, Show, Typeable, Generic)
instance Hashable GetTestDiagnostics
instance NFData   GetTestDiagnostics
type instance RuleResult GetTestDiagnostics = ()