really enable Test plugin

Author: pepeiborra

ghcide/exe/Main.hs

@@ -51,7 +51,9 @@ main = do
 
     whenJust argsCwd IO.setCurrentDirectory
 
-    Main.defaultMain def
+    let arguments = if argsTesting then Main.testing else def
+
+    Main.defaultMain arguments
         {Main.argCommand = argsCommand
 
         ,Main.argsRules = do
@@ -62,20 +64,13 @@ main = do
             unless argsDisableKick $
                 action kick
 
-        ,Main.argsHlsPlugins =
-            pluginDescToIdePlugins $
-            GhcIde.descriptors
-            ++ [Test.blockCommandDescriptor "block-command" | argsTesting]
-            ++ [Test.plugin | argsTesting]
-
         ,Main.argsThreads = case argsThreads of 0 -> Nothing ; i -> Just (fromIntegral i)
 
-        ,Main.argsIdeOptions = \config  sessionLoader ->
-            let defOptions = defaultIdeOptions sessionLoader
+        ,Main.argsIdeOptions = \config sessionLoader ->
+            let defOptions = Main.argsIdeOptions arguments config sessionLoader
             in defOptions
                 { optShakeProfiling = argsShakeProfiling
                 , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
-                , optTesting = IdeTesting argsTesting
                 , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
                 , optCheckParents = pure $ checkParents config
                 , optCheckProject = pure $ checkProject config

ghcide/src/Development/IDE/Main.hs

@@ -6,7 +6,7 @@ module Development.IDE.Main
 ,isLSP
 ,commandP
 ,defaultMain
-) where
+,testing) where
 import           Control.Concurrent.Extra              (newLock, readVar,
                                                         withLock,
                                                         withNumCapabilities)
@@ -55,6 +55,7 @@ import           Development.IDE.LSP.LanguageServer    (runLanguageServer)
 import           Development.IDE.Plugin                (Plugin (pluginHandlers, pluginModifyDynflags, pluginRules))
 import           Development.IDE.Plugin.HLS            (asGhcIdePlugin)
 import qualified Development.IDE.Plugin.HLS.GhcIde     as Ghcide
+import qualified Development.IDE.Plugin.Test           as Test
 import           Development.IDE.Session               (SessionLoadingOptions,
                                                         getHieDbLoc,
                                                         loadSessionWithOptions,
@@ -65,9 +66,11 @@ import           Development.IDE.Types.Location        (NormalizedUri,
 import           Development.IDE.Types.Logger          (Logger (Logger))
 import           Development.IDE.Types.Options         (IdeGhcSession,
                                                         IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
+                                                        IdeTesting (IdeTesting),
                                                         clientSupportsProgress,
                                                         defaultIdeOptions,
-                                                        optModifyDynFlags)
+                                                        optModifyDynFlags,
+                                                        optTesting)
 import           Development.IDE.Types.Shake           (Key (Key))
 import           GHC.Conc                              (getNumProcessors)
 import           GHC.IO.Encoding                       (setLocaleEncoding)
@@ -81,6 +84,7 @@ import           Ide.Plugin.ConfigUtils                (pluginsToDefaultConfig,
                                                         pluginsToVSCodeExtensionSchema)
 import           Ide.PluginUtils                       (allLspCmdIds',
                                                         getProcessID,
+                                                        idePluginsToPluginDesc,
                                                         pluginDescToIdePlugins)
 import           Ide.Types                             (IdeCommand (IdeCommand),
                                                         IdePlugins,
@@ -201,6 +205,18 @@ instance Default Arguments where
                 return newStdout
         }
 
+testing :: Arguments
+testing = def {
+    argsHlsPlugins = pluginDescToIdePlugins $
+        idePluginsToPluginDesc (argsHlsPlugins def)
+        ++ [Test.blockCommandDescriptor "block-command", Test.plugin],
+    argsIdeOptions = \config sessionLoader ->
+            let defOptions = argsIdeOptions def config sessionLoader
+            in defOptions {
+                optTesting = IdeTesting True
+            }
+}
+
 -- | Cheap stderr logger that relies on LineBuffering
 stderrLogger :: IO Logger
 stderrLogger = do

ghcide/test/exe/Main.hs

@@ -4627,7 +4627,7 @@ projectCompletionTests =
                 <- compls
               , _label == "anidentifier"
               ]
-        liftIO $ compls' @?= ["Defined in 'A"], 
+        liftIO $ compls' @?= ["Defined in 'A"],
       testSession' "auto complete project imports" $ \dir-> do
         liftIO $ writeFile (dir </> "hie.yaml")
             "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}"
@@ -5822,7 +5822,7 @@ unitTests = do
                     | i <- [(1::Int)..20]
                 ] ++ Ghcide.descriptors
 
-        testIde def{IDE.argsHlsPlugins = plugins} $ do
+        testIde IDE.testing{IDE.argsHlsPlugins = plugins} $ do
             _ <- createDoc "haskell" "A.hs" "module A where"
             waitForProgressDone
             actualOrder <- liftIO $ readIORef orderRef

hls-plugin-api/src/Ide/PluginUtils.hs

@@ -10,6 +10,7 @@ module Ide.PluginUtils
     diffText,
     diffText',
     pluginDescToIdePlugins,
+    idePluginsToPluginDesc,
     responseError,
     getClientConfig,
     getPluginConfig,
@@ -24,7 +25,8 @@ module Ide.PluginUtils
     allLspCmdIds',
     installSigUsr1Handler,
     subRange,
-    usePropertyLsp)
+    usePropertyLsp,
+    )
 where
 
 
@@ -149,6 +151,8 @@ pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
 pluginDescToIdePlugins plugins =
     IdePlugins $ map (\p -> (pluginId p, p)) $ nubOrdOn pluginId plugins
 
+idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
+idePluginsToPluginDesc (IdePlugins pp) = map snd pp
 
 -- ---------------------------------------------------------------------
 -- | Returns the current client configuration. It is not wise to permanently

hls-test-utils/src/Test/Hls.hs

@@ -48,7 +48,8 @@ import           Development.IDE.Plugin.Test       (TestRequest (WaitForShakeQue
 import           Development.IDE.Types.Options
 import           GHC.IO.Handle
 import           Ide.Plugin.Config                 (Config, formattingProvider)
-import           Ide.PluginUtils                   (pluginDescToIdePlugins)
+import           Ide.PluginUtils                   (idePluginsToPluginDesc,
+                                                    pluginDescToIdePlugins)
 import           Ide.Types
 import           Language.LSP.Test
 import           Language.LSP.Types                hiding
@@ -170,15 +171,15 @@ runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurren
   server <-
     async $
       Ghcide.defaultMain
-        def
+        testing
           { argsHandleIn = pure inR,
             argsHandleOut = pure outW,
             argsDefaultHlsConfig = conf,
             argsLogger = pure noLogging,
             argsIdeOptions = \config sessionLoader ->
               let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
                in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
-            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
+            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ idePluginsToPluginDesc (argsHlsPlugins testing)
           }
   x <- runSessionWithHandles inW outR sconf caps root s
   hClose inW