[Migrate diagnosticTests] part of #4173 Migrate ghcide tests to hls test utils

ghcide/exe/Main.hs

@@ -124,12 +124,7 @@ main = withTelemetryRecorder $ \telemetryRecorder -> do
         , IDEMain.argsHlsPlugins = IDEMain.argsHlsPlugins arguments <> pluginDescToIdePlugins [lspRecorderPlugin]
 
         , IDEMain.argsRules = do
-            -- install the main and ghcide-plugin rules
             mainRule (cmapWithPrio LogRules recorder) def
-            -- install the kick action, which triggers a typecheck on every
-            -- Shake database restart, i.e. on every user edit.
-            unless argsDisableKick $
-                action kick
 
         , IDEMain.argsThreads = case argsThreads of 0 -> Nothing ; i -> Just (fromIntegral i)
 

ghcide/src/Development/IDE/Main.hs

@@ -223,13 +223,14 @@ data Arguments = Arguments
     , argsHandleOut             :: IO Handle
     , argsThreads               :: Maybe Natural
     , argsMonitoring            :: IO Monitoring
+    , argsDisableKick           :: Bool -- ^ flag to disable kick used for testing
     }
 
 defaultArguments :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Arguments
 defaultArguments recorder plugins = Arguments
         { argsProjectRoot = Nothing
         , argCommand = LSP
-        , argsRules = mainRule (cmapWithPrio LogRules recorder) def >> action kick
+        , argsRules = mainRule (cmapWithPrio LogRules recorder) def
         , argsGhcidePlugin = mempty
         , argsHlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde recorder)) <> plugins
         , argsSessionLoadingOptions = def
@@ -258,6 +259,7 @@ defaultArguments recorder plugins = Arguments
                 putStr " " >> hFlush stdout
                 return newStdout
         , argsMonitoring = OpenTelemetry.monitoring
+        , argsDisableKick = False
         }
 
 
@@ -293,7 +295,13 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
         plugins = hlsPlugin <> argsGhcidePlugin
         options = argsLspOptions { LSP.optExecuteCommandCommands = LSP.optExecuteCommandCommands argsLspOptions <> Just hlsCommands }
         argsParseConfig = getConfigFromNotification argsHlsPlugins
-        rules = argsRules >> pluginRules plugins
+        rules = do
+            argsRules
+            unless argsDisableKick $ action kick
+            pluginRules plugins
+        -- install the main and ghcide-plugin rules
+        -- install the kick action, which triggers a typecheck on every
+        -- Shake database restart, i.e. on every user edit.
 
     debouncer <- argsDebouncer
     inH <- argsHandleIn

ghcide/test/exe/ClientSettingsTests.hs

@@ -14,6 +14,7 @@ import           Language.LSP.Protocol.Types     hiding
                                                   SemanticTokensEdit (..),
                                                   mkRange)
 import           Language.LSP.Test
+import           Test.Hls                        (waitForProgressDone)
 import           Test.Tasty
 import           TestUtils
 

ghcide/test/exe/CodeLensTests.hs

@@ -18,6 +18,7 @@ import           Language.LSP.Protocol.Types     hiding
                                                   SemanticTokensEdit (..),
                                                   mkRange)
 import           Language.LSP.Test
+import           Test.Hls                        (waitForProgressDone)
 import           Test.Tasty
 import           Test.Tasty.HUnit
 import           TestUtils

ghcide/test/exe/CompletionTests.hs

@@ -49,10 +49,10 @@ tests
     ]
 
 testSessionEmpty :: TestName -> Session () -> TestTree
-testSessionEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]])
+testSessionEmpty name = testWithDummyPlugin name (mkIdeTestFs [FS.directCradle ["A.hs"]])
 
 testSessionEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree
-testSessionEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)])
+testSessionEmptyWithCradle name cradle = testWithDummyPlugin name (mkIdeTestFs [file "hie.yaml" (text cradle)])
 
 testSessionSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree
 testSessionSingleFile testName fp txt session =

ghcide/test/exe/Config.hs

@@ -1,11 +1,37 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module Config where
-
+module Config(
+    -- * basic config for ghcIde testing
+    mkIdeTestFs
+    , dummyPlugin
+
+    -- * runners for testing with dummy plugin
+    , runWithDummyPlugin
+    , testWithDummyPlugin
+    , testWithDummyPluginEmpty
+    , testWithDummyPlugin'
+    , testWithDummyPluginEmpty'
+    , testWithDummyPluginAndCap'
+    , runWithExtraFiles
+    , testWithExtraFiles
+
+    -- * utilities for testing definition and hover
+    , Expect(..)
+    , pattern R
+    , mkR
+    , checkDefs
+    , mkL
+    , lspTestCaps
+    , lspTestCapsNoFileWatches
+    ) where
+
+import           Control.Lens.Setter         ((.~))
 import           Data.Foldable               (traverse_)
+import           Data.Function               ((&))
 import qualified Data.Text                   as T
 import           Development.IDE.Test        (canonicalizeUri)
 import           Ide.Types                   (defaultPluginDescriptor)
+import qualified Language.LSP.Protocol.Lens  as L
 import           Language.LSP.Protocol.Types (Null (..))
 import           System.FilePath             ((</>))
 import           Test.Hls
@@ -28,22 +54,18 @@ runWithDummyPlugin = runSessionWithServerInTmpDir def dummyPlugin
 runWithDummyPlugin' ::  FS.VirtualFileTree -> (FileSystem -> Session a) -> IO a
 runWithDummyPlugin' = runSessionWithServerInTmpDirCont' def dummyPlugin
 
-runWithDummyPluginAndCap :: ClientCapabilities -> Session () -> IO ()
-runWithDummyPluginAndCap cap = runSessionWithServerAndCapsInTmpDir def dummyPlugin cap (mkIdeTestFs [])
+runWithDummyPluginAndCap' :: ClientCapabilities -> (FileSystem -> Session ()) -> IO ()
+runWithDummyPluginAndCap' cap = runSessionWithServerAndCapsInTmpDirCont def dummyPlugin cap (mkIdeTestFs [])
 
-testWithDummyPluginAndCap :: String -> ClientCapabilities -> Session () -> TestTree
-testWithDummyPluginAndCap caseName cap = testCase caseName . runWithDummyPluginAndCap cap
+testWithDummyPluginAndCap' :: String -> ClientCapabilities -> (FileSystem -> Session ()) -> TestTree
+testWithDummyPluginAndCap' caseName cap = testCase caseName . runWithDummyPluginAndCap' cap
 
--- testSessionWithCorePlugin ::(TestRunner cont ()) => TestName -> FS.VirtualFileTree -> cont -> TestTree
 testWithDummyPlugin :: String -> FS.VirtualFileTree -> Session () -> TestTree
-testWithDummyPlugin caseName vfs = testCase caseName . runWithDummyPlugin vfs
+testWithDummyPlugin caseName vfs = testWithDummyPlugin' caseName vfs . const
 
 testWithDummyPlugin' :: String -> FS.VirtualFileTree -> (FileSystem -> Session ()) -> TestTree
 testWithDummyPlugin' caseName vfs = testCase caseName . runWithDummyPlugin' vfs
 
-runWithDummyPluginEmpty :: Session a -> IO a
-runWithDummyPluginEmpty = runWithDummyPlugin $ mkIdeTestFs []
-
 testWithDummyPluginEmpty :: String -> Session () -> TestTree
 testWithDummyPluginEmpty caseName = testWithDummyPlugin caseName $ mkIdeTestFs []
 
@@ -114,3 +136,9 @@ defToLocation (InL (Definition (InL l))) = [l]
 defToLocation (InL (Definition (InR ls))) = ls
 defToLocation (InR (InL defLink)) = (\(DefinitionLink LocationLink{_targetUri,_targetRange}) -> Location _targetUri _targetRange) <$> defLink
 defToLocation (InR (InR Null)) = []
+
+lspTestCaps :: ClientCapabilities
+lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
+
+lspTestCapsNoFileWatches :: ClientCapabilities
+lspTestCapsNoFileWatches = lspTestCaps & L.workspace . traverse . L.didChangeWatchedFiles .~ Nothing