Remove command descriptions

Also only needed by the JSON transport

Author: lukel97

hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs

@@ -271,14 +271,13 @@ data PluginDescriptor =
                    } deriving (Generic)
 
 instance Show PluginCommand where
-  show (PluginCommand name _ _) = "PluginCommand { name = " ++ T.unpack name ++ " }"
+  show (PluginCommand name _) = "PluginCommand { name = " ++ T.unpack name ++ " }"
 
 type PluginId = T.Text
 type CommandName = T.Text
 
 data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>
   PluginCommand { commandName :: CommandName
-                , commandDesc :: T.Text
                 , commandFunc :: a -> IdeGhcM (IdeResult b)
                 }
 
@@ -308,7 +307,7 @@ runPluginCommand p com arg = do
     Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
       Nothing -> return $ IdeResultFail $
         IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
-      Just (PluginCommand _ _ f) -> case fromJSON arg of
+      Just (PluginCommand _ f) -> case fromJSON arg of
         Error err -> return $ IdeResultFail $
           IdeError ParameterError ("error while parsing args for " <> com <> " in plugin " <> p <> ": " <> T.pack err) Null
         Success a -> do
@@ -323,7 +322,7 @@ newtype IdePlugins = IdePlugins
 -- TODO:AZ this is a defective instance, do we actually need it?
 -- Perhaps rather make a separate type explicitly for this purpose.
 instance ToJSON IdePlugins where
-  toJSON (IdePlugins m) = toJSON $ fmap (\x -> (commandName x, commandDesc x)) <$> fmap pluginCommands m
+  toJSON (IdePlugins m) = toJSON $ fmap commandName <$> fmap pluginCommands m
 
 -- | For the diagnostic providers in the config, return a map of
 -- current enabled state, indexed by the plugin id.

src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs

@@ -42,8 +42,8 @@ applyRefactDescriptor :: PluginId -> PluginDescriptor
 applyRefactDescriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginCommands =
-      [ PluginCommand "applyOne" "Apply a single hint" applyOneCmd
-      , PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd
+      [ PluginCommand "applyOne" applyOneCmd
+      , PluginCommand "applyAll" applyAllCmd
       ]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing

src/Haskell/Ide/Engine/Plugin/Example2.hs

@@ -23,9 +23,9 @@ example2Descriptor :: PluginId -> PluginDescriptor
 example2Descriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginCommands =
-      [ PluginCommand "sayHello" "say hello" sayHelloCmd
-      , PluginCommand "sayHelloTo ""say hello to the passed in param" sayHelloToCmd
-      , PluginCommand "todo" "Add a TODO marker" todoCmd
+      [ PluginCommand "sayHello" sayHelloCmd
+      , PluginCommand "sayHelloTo" sayHelloToCmd
+      , PluginCommand "todo" todoCmd
       ]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider

src/Haskell/Ide/Engine/Plugin/Generic.hs

@@ -43,7 +43,7 @@ import           PprTyThing
 genericDescriptor :: PluginId -> PluginDescriptor
 genericDescriptor plId = PluginDescriptor
   { pluginId = plId
-  , pluginCommands = [PluginCommand "type" "Get the type of the expression under (LINE,COL)" typeCmd]
+  , pluginCommands = [PluginCommand "type" typeCmd]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing
   , pluginHoverProvider = Just hoverProvider

src/Haskell/Ide/Engine/Plugin/HfaAlign.hs

@@ -29,7 +29,7 @@ hfaAlignDescriptor :: PluginId -> PluginDescriptor
 hfaAlignDescriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginCommands =
-      [ PluginCommand "align" "Align = in active range" alignCmd
+      [ PluginCommand "align" alignCmd
       ]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing

src/Haskell/Ide/Engine/Plugin/HsImport.hs

@@ -31,7 +31,7 @@ import qualified Safe as S
 hsimportDescriptor :: PluginId -> PluginDescriptor
 hsimportDescriptor plId = PluginDescriptor
   { pluginId = plId
-  , pluginCommands = [PluginCommand "import" "Import a module" importModule]
+  , pluginCommands = [PluginCommand "import" importModule]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing
   , pluginHoverProvider = Nothing

src/Haskell/Ide/Engine/Plugin/Package.hs

@@ -53,7 +53,7 @@ import qualified Data.Yaml as Y
 packageDescriptor :: T.Text -> PluginDescriptor
 packageDescriptor plId = PluginDescriptor
   { pluginId       = plId
-  , pluginCommands = [PluginCommand "add" "Add a packge" addCmd]
+  , pluginCommands = [PluginCommand "add" addCmd]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing
   , pluginHoverProvider = Nothing

src/Haskell/Ide/Engine/Plugin/Pragmas.hs

@@ -19,7 +19,7 @@ pragmasDescriptor :: PluginId -> PluginDescriptor
 pragmasDescriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginCommands =
-      [ PluginCommand "addPragma" "add the given pragma" addPragmaCmd
+      [ PluginCommand "addPragma" addPragmaCmd
       ]
   , pluginCodeActionProvider = Just codeActionProvider
   , pluginDiagnosticProvider = Nothing

test/dispatcher/Main.hs

@@ -13,6 +13,7 @@ import qualified Data.Text as T
 import           Data.Default
 import           GHC                            ( TypecheckedModule )
 import           GHC.Generics
+import           Haskell.Ide.Engine.Ghc
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
 import           Haskell.Ide.Engine.Scheduler
@@ -33,7 +34,6 @@ import System.IO
 import           Haskell.Ide.Engine.Plugin.ApplyRefact
 import           Haskell.Ide.Engine.Plugin.Example2
 -- import           Haskell.Ide.Engine.Plugin.HaRe
-import           Haskell.Ide.Engine.Plugin.Bios
 import           Haskell.Ide.Engine.Plugin.Generic
 
 {-# ANN module ("HLint: ignore Redundant do"       :: String) #-}
@@ -64,7 +64,6 @@ plugins :: IdePlugins
 plugins = pluginDescToIdePlugins
   [applyRefactDescriptor "applyrefact"
   ,example2Descriptor "eg2"
-  ,biosDescriptor "bios"
   ]
 
 startServer :: IO (Scheduler IO, TChan LogVal, ThreadId)
@@ -90,17 +89,17 @@ logToChan c t = atomically $ writeTChan c t
 
 -- ---------------------------------------------------------------------
 
-dispatchGhcRequest :: ToJSON a
+dispatchGhcRequest :: (Typeable a, ToJSON a)
                    => TrackingNumber -> Maybe Uri -> String -> Int
                    -> Scheduler IO -> TChan LogVal
-                   -> PluginId -> CommandName -> a -> IO ()
-dispatchGhcRequest tn uri ctx n scheduler lc plugin com arg = do
+                   -> IdeGhcM (IdeResult a) -> IO ()
+dispatchGhcRequest tn uri ctx n scheduler lc f = do
   let
     logger :: RequestCallback IO DynamicJSON
     logger x = logToChan lc (ctx, Right x)
 
   let req = GReq tn "plugin-command" uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $
-        runPluginCommand plugin com (toJSON arg)
+        fmap toDynJSON <$> f
   sendRequest scheduler req
 
 
@@ -163,7 +162,7 @@ funcSpec = describe "functional dispatch" $ do
       show rrr `shouldBe` "Nothing"
 
       -- need to typecheck the module to trigger deferred response
-      dispatchGhcRequest 2 (Just testUri) "req2" 2 scheduler logChan "bios" "check" (toJSON testUri)
+      dispatchGhcRequest 2 (Just testUri) "req2" 2 scheduler logChan $ setTypecheckedModule testUri
 
       -- And now we get the deferred response (once the module is loaded)
       ("req1",Right res) <- atomically $ readTChan logChan
@@ -245,7 +244,7 @@ funcSpec = describe "functional dispatch" $ do
 
     it "returns hints as diagnostics" $ do
 
-      dispatchGhcRequest 5 (Just testUri) "r5" 5 scheduler logChan "applyrefact" "lint" testUri
+      dispatchGhcRequest 5 (Just testUri) "r5" 5 scheduler logChan $ lint testUri
 
       hr5 <- atomically $ readTChan logChan
       unpackRes hr5 `shouldBe` ("r5",
@@ -275,7 +274,7 @@ funcSpec = describe "functional dispatch" $ do
       --     (Just $ H.singleton r6uri textEdits)
       --     Nothing
       --   ))
-      dispatchGhcRequest 6 (Just testUri) "r6" 6 scheduler logChan "bios" "check" (toJSON testUri)
+      dispatchGhcRequest 6 (Just testUri) "r6" 6 scheduler logChan $ setTypecheckedModule testUri
       hr6 <- atomically $ readTChan logChan
       unpackRes hr6 `shouldBe` ("r6",Nothing :: Maybe Int)
 
@@ -285,7 +284,7 @@ funcSpec = describe "functional dispatch" $ do
 
       dispatchIdeRequest 7 "req7" scheduler logChan (IdInt 7) $ findDef testFailUri (Position 1 2)
 
-      dispatchGhcRequest 8 (Just testUri) "req8" 8 scheduler logChan "bios" "check" (toJSON testFailUri)
+      dispatchGhcRequest 8 (Just testUri) "req8" 8 scheduler logChan $ setTypecheckedModule testFailUri
 
       hr7 <- atomically $ readTChan logChan
       unpackRes hr7 `shouldBe` ("req7", Just ([] :: [Location]))

test/unit/ExtensibleStateSpec.hs

@@ -36,8 +36,8 @@ testDescriptor :: PluginId -> PluginDescriptor
 testDescriptor plId = PluginDescriptor
   { pluginId = plId
   , pluginCommands = [
-        PluginCommand "cmd1" "description" cmd1
-      , PluginCommand "cmd2" "description" cmd2
+        PluginCommand "cmd1" cmd1
+      , PluginCommand "cmd2" cmd2
       ]
   , pluginCodeActionProvider = Nothing
   , pluginDiagnosticProvider = Nothing