ghcide code lens command now works

Author: alanz

exe/Main.hs

@@ -114,7 +114,7 @@ idePlugins pid includeExamples
       -- , hsimportDescriptor    "hsimport"
       -- , liquidDescriptor      "liquid"
       -- , packageDescriptor     "package"
-        GhcIde.descriptor  "ghc"
+        GhcIde.descriptor  "ghcide"
       , Pragmas.descriptor  "pragmas"
       , Floskell.descriptor "floskell"
       -- , genericDescriptor     "generic"
@@ -164,7 +164,7 @@ main = do
         plugins = Completions.plugin <> CodeAction.plugin <>
                   Plugin mempty HoverDefinition.setHandlersDefinition <>
                   ps
-        options = def { LSP.executeCommandCommands = Just (pid <> ":typesignature.add":commandIds)
+        options = def { LSP.executeCommandCommands = Just commandIds
                       , LSP.completionTriggerCharacters = Just "."
                       }
 

ghcide

@@ -205,7 +205,7 @@ executeCommandHandlers ecs = PartialHandlers $ \WithMessage{..} x -> return x{
 --                             -> ExecuteCommandParams
 --                             -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
 makeExecuteCommands :: [(PluginId, [PluginCommand])] -> LSP.LspFuncs Config -> ExecuteCommandProvider
-makeExecuteCommands ecs _lf _params = do
+makeExecuteCommands ecs lf ide = do
   let
       pluginMap = Map.fromList ecs
       parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
@@ -250,7 +250,7 @@ makeExecuteCommands ecs _lf _params = do
               --                           "Invalid fallbackCodeAction params"
 
           -- Just an ordinary HIE command
-          Just (plugin, cmd) -> runPluginCommand pluginMap plugin cmd cmdParams
+          Just (plugin, cmd) -> runPluginCommand pluginMap lf ide plugin cmd cmdParams
 
           -- Couldn't parse the command identifier
           _ -> return (Left $ ResponseError InvalidParams "Invalid command identifier" Nothing, Nothing)
@@ -333,20 +333,33 @@ makeExecuteCommands ecs _lf _params = do
 
 -- | Runs a plugin command given a PluginId, CommandId and
 -- arguments in the form of a JSON object.
-runPluginCommand :: Map.Map PluginId [PluginCommand] -> PluginId -> CommandId -> J.Value
-                  -> IO (Either ResponseError J.Value,
+runPluginCommand :: Map.Map PluginId [PluginCommand]
+                 -> LSP.LspFuncs Config
+                 -> IdeState
+                 -> PluginId
+                 -> CommandId
+                 -> J.Value
+                 -> IO (Either ResponseError J.Value,
                         Maybe (ServerMethod, ApplyWorkspaceEditParams))
-runPluginCommand m p@(PluginId p') com@(CommandId com') arg =
+runPluginCommand m lf ide  p@(PluginId p') com@(CommandId com') arg =
   case Map.lookup p m of
     Nothing -> return
       (Left $ ResponseError InvalidRequest ("Plugin " <> p' <> " doesn't exist") Nothing, Nothing)
     Just xs -> case List.find ((com ==) . commandId) xs of
       Nothing -> return (Left $
-        ResponseError InvalidRequest ("Command " <> com' <> " isn't defined for plugin " <> p' <> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Nothing, Nothing)
+        ResponseError InvalidRequest ("Command " <> com' <> " isn't defined for plugin " <> p'
+                                      <> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Nothing, Nothing)
       Just (PluginCommand _ _ f) -> case J.fromJSON arg of
         J.Error err -> return (Left $
-          ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p' <> ": " <> T.pack err) Nothing, Nothing)
-        J.Success a -> f a
+          ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p'
+                                       <> ": " <> T.pack err
+                                       <> "\narg = " <> T.pack (show arg)) Nothing, Nothing)
+        J.Success a -> f lf ide a
+
+-- lsp-request: error while parsing args for typesignature.add in plugin ghcide:
+-- When parsing the record ExecuteCommandParams of type
+-- Language.Haskell.LSP.Types.DataTypesJSON.ExecuteCommandParams the key command
+-- was not present.
 
 -- -----------------------------------------------------------
 

src/Ide/Plugin.hs

@@ -146,9 +146,8 @@ data AddTodoParams = AddTodoParams
   }
   deriving (Show, Eq, Generic, ToJSON, FromJSON)
 
-addTodoCmd :: AddTodoParams -> IO (Either ResponseError Value,
-                           Maybe (ServerMethod, ApplyWorkspaceEditParams))
-addTodoCmd (AddTodoParams uri todoText) = do
+addTodoCmd :: CommandFunction AddTodoParams
+addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
   let
     pos = Position 3 0
     textEdits = List

src/Ide/Plugin/Example.hs

@@ -143,9 +143,8 @@ data AddTodoParams = AddTodoParams
   }
   deriving (Show, Eq, Generic, ToJSON, FromJSON)
 
-addTodoCmd :: AddTodoParams -> IO (Either ResponseError Value,
-                           Maybe (ServerMethod, ApplyWorkspaceEditParams))
-addTodoCmd (AddTodoParams uri todoText) = do
+addTodoCmd :: CommandFunction AddTodoParams
+addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
   let
     pos = Position 5 0
     textEdits = List

src/Ide/Plugin/Example2.hs

@@ -5,20 +5,22 @@ module Ide.Plugin.GhcIde
     descriptor
   ) where
 
+import Data.Aeson
 import Development.IDE.Core.Service
 import Development.IDE.LSP.HoverDefinition
+import Development.IDE.Plugin.CodeAction
 import Development.IDE.Types.Logger
 import Ide.Types
+import Language.Haskell.LSP.Types
 import Text.Regex.TDFA.Text()
-import Development.IDE.Plugin.CodeAction
 
 -- ---------------------------------------------------------------------
 
 descriptor :: PluginId -> PluginDescriptor
 descriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginRules = mempty
-  , pluginCommands = []
+  , pluginCommands = [PluginCommand (CommandId "typesignature.add") "adds a signature" commandAddSignature]
   , pluginCodeActionProvider = Just codeAction'
   , pluginCodeLensProvider   = Just codeLens'
   , pluginDiagnosticProvider = Nothing
@@ -37,6 +39,12 @@ hover' ideState params = do
 
 -- ---------------------------------------------------------------------
 
+commandAddSignature :: CommandFunction WorkspaceEdit
+commandAddSignature lf ide params
+    = executeAddSignatureCommand lf ide (ExecuteCommandParams "typesignature.add" (Just (List [toJSON params])) Nothing)
+
+-- ---------------------------------------------------------------------
+
 codeAction' :: CodeActionProvider
 codeAction' lf ide _ doc range context = codeAction lf ide doc range context
 

src/Ide/Plugin/GhcIde.hs

@@ -56,10 +56,8 @@ data AddPragmaParams = AddPragmaParams
 -- Pragma is added to the first line of the Uri.
 -- It is assumed that the pragma name is a valid pragma,
 -- thus, not validated.
--- addPragmaCmd :: AddPragmaParams -> IO (Either ResponseError J.WorkspaceEdit)
-addPragmaCmd :: AddPragmaParams -> IO (Either ResponseError Value,
-                           Maybe (ServerMethod, ApplyWorkspaceEditParams))
-addPragmaCmd (AddPragmaParams uri pragmaName) = do
+addPragmaCmd :: CommandFunction AddPragmaParams
+addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do
   let
     pos = J.Position 0 0
     textEdits = J.List

src/Ide/Plugin/Pragmas.hs

@@ -16,6 +16,7 @@ module Ide.Types
     , HoverProvider
     , CodeActionProvider
     , CodeLensProvider
+    , CommandFunction
     , ExecuteCommandProvider
     , CompletionProvider
     , WithSnippets(..)
@@ -80,10 +81,15 @@ instance IsString CommandId where
 data PluginCommand = forall a. (FromJSON a) =>
   PluginCommand { commandId   :: CommandId
                 , commandDesc :: T.Text
-                , commandFunc :: a -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+                , commandFunc :: CommandFunction a
                 }
 -- ---------------------------------------------------------------------
 
+type CommandFunction a = LSP.LspFuncs Config
+                       -> IdeState
+                       -> a
+                       -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+
 type CodeActionProvider = LSP.LspFuncs Config
                         -> IdeState
                         -> PluginId