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