Extract the block command handler to an HLS plugin

Previously defined together with the type lenses command handler

Author: pepeiborra

ghcide/exe/Main.hs

@@ -88,9 +88,11 @@ main = do
 
     dir <- IO.getCurrentDirectory
 
-    let hlsPlugins = pluginDescToIdePlugins
+    let hlsPlugins = pluginDescToIdePlugins $
             [ GhcIde.descriptor "ghcide"
-            , TypeLenses.descriptor "type-lenses" ]
+            , TypeLenses.descriptor "type-lenses"
+            ] ++
+            [ Test.blockCommandDescriptor "block-command" | argsTesting]
 
     pid <- T.pack . show <$> getProcessID
     let hlsPlugin = asGhcIdePlugin hlsPlugins

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -13,7 +13,6 @@ module Development.IDE.Plugin.CodeAction
     , rulePackageExports
 
     -- * For testing
-    , blockCommandId
     , matchRegExMultipleImports
     ) where
 
@@ -57,9 +56,6 @@ import Control.Concurrent.Extra (readVar)
 import Development.IDE.GHC.Util (printRdrName)
 import Ide.PluginUtils (subRange)
 
--- | a command that blocks forever. Used for testing
-blockCommandId :: T.Text
-blockCommandId = "ghcide.command.block"
 -- | Generate code actions.
 codeAction
     :: LSP.LspFuncs c

ghcide/src/Development/IDE/Plugin/Test.hs

@@ -5,6 +5,8 @@ module Development.IDE.Plugin.Test
   ( TestRequest(..)
   , WaitForIdeRuleResult(..)
   , plugin
+  , blockCommandDescriptor
+  , blockCommandId
   ) where
 
 import Control.Monad.STM
@@ -32,6 +34,9 @@ import Data.Bifunctor
 import Data.Text (pack, Text)
 import Data.String
 import Development.IDE.Types.Location (fromUri)
+import Control.Concurrent (threadDelay)
+import Ide.Types
+import qualified Language.Haskell.LSP.Core as LSP
 
 data TestRequest
     = BlockSeconds Seconds           -- ^ :: Null
@@ -104,3 +109,20 @@ parseAction "gethieast" fp = Right . isJust <$> use GetHieAst fp
 parseAction "getDependencies" fp = Right . isJust <$> use GetDependencies fp
 parseAction "getFileContents" fp = Right . isJust <$> use GetFileContents fp
 parseAction other _ = return $ Left $ "Cannot parse ide rule: " <> pack (original other)
+
+-- | a command that blocks forever. Used for testing
+blockCommandId :: Text
+blockCommandId = "ghcide.command.block"
+
+blockCommandDescriptor :: PluginId -> PluginDescriptor state
+blockCommandDescriptor plId = (defaultPluginDescriptor plId) {
+    pluginCommands = [PluginCommand (CommandId blockCommandId) "blocks forever" blockCommandHandler]
+}
+
+blockCommandHandler :: CommandFunction state ExecuteCommandParams
+blockCommandHandler lsp _ideState _params
+    = do
+        LSP.sendFunc lsp $ NotCustomServer $
+            NotificationMessage "2.0" (CustomServerMethod "ghcide/blocking/command") Null
+        threadDelay maxBound
+        return (Right Null, Nothing)

ghcide/test/exe/Main.hs

@@ -60,8 +60,8 @@ import Test.Tasty.Ingredients.Rerun
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 import System.Time.Extra
-import Development.IDE.Plugin.Test (WaitForIdeRuleResult(..), TestRequest(BlockSeconds,GetInterfaceFilesDir))
 import Development.IDE.Plugin.CodeAction (matchRegExMultipleImports)
+import Development.IDE.Plugin.Test (TestRequest (BlockSeconds, GetInterfaceFilesDir), WaitForIdeRuleResult (..), blockCommandId)
 import Control.Monad.Extra (whenJust)
 import qualified Language.Haskell.LSP.Types.Lens as L
 import Control.Lens ((^.))