Move lookupPluginId to IdePlugins

Author: wz1000

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -57,9 +57,9 @@ import           GHC.Plugins                              (Depth (AllTheWay),
                                                            renderWithContext,
                                                            sdocStyle)
 #endif
-import           Ide.PluginUtils                          (mkLspCommand, lookupPluginId)
+import           Ide.PluginUtils                          (mkLspCommand)
 import           Ide.Types                                (CommandId (..),
-                                                           IdePlugins, PluginId)
+                                                           IdePlugins(..), PluginId)
 import           Language.LSP.Types
 import           Language.LSP.Types.Capabilities
 import qualified Language.LSP.VFS                         as VFS
@@ -665,7 +665,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
         -- assumes that nubOrdBy is stable
         let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` snd . Fuzzy.original) filtCompls
         let compls = (fmap.fmap.fmap) (mkCompl pId ideOpts) uniqueFiltCompls
-            pId = lookupPluginId (CommandId extendImportCommandId) plugins
+            pId = lookupCommandProvider plugins (CommandId extendImportCommandId)
         return $
           (fmap.fmap) snd $
           sortBy (compare `on` lexicographicOrdering) $

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

@@ -86,7 +86,7 @@ logAndReturnError recorder errCode msg = do
 
 -- | Map a set of plugins to the underlying ghcide engine.
 asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config
-asGhcIdePlugin recorder (IdePlugins ls) =
+asGhcIdePlugin recorder (IdePlugins ls _) =
     mkPlugin rulesPlugins HLS.pluginRules <>
     mkPlugin (executeCommandPlugins recorder) HLS.pluginCommands <>
     mkPlugin (extensiblePlugins recorder) id <>

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

@@ -32,7 +32,6 @@ module Ide.PluginUtils
     handleMaybe,
     handleMaybeM,
     throwPluginError,
-    lookupPluginId
     )
 where
 
@@ -162,10 +161,11 @@ clientSupportsDocumentChanges caps =
 
 pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
 pluginDescToIdePlugins plugins =
-    IdePlugins $ map (\p -> (pluginId p, p)) $ nubOrdOn pluginId plugins
+    IdePlugins xs (lookupPluginId xs)
+  where xs = map (\p -> (pluginId p, p)) $ nubOrdOn pluginId plugins
 
 idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
-idePluginsToPluginDesc (IdePlugins pp) = map snd pp
+idePluginsToPluginDesc (IdePlugins pp _) = map snd pp
 
 -- ---------------------------------------------------------------------
 -- | Returns the current client configuration. It is not wise to permanently
@@ -228,7 +228,7 @@ positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is e
 -- ---------------------------------------------------------------------
 
 allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
-allLspCmdIds' pid (IdePlugins ls) = mkPlugin (allLspCmdIds pid) (Just . pluginCommands)
+allLspCmdIds' pid (IdePlugins ls _) = mkPlugin (allLspCmdIds pid) (Just . pluginCommands)
     where
         justs (p, Just x)  = [(p, x)]
         justs (_, Nothing) = []
@@ -245,8 +245,8 @@ allLspCmdIds pid commands = concatMap go commands
 
 
 -- | Lookup the plugin that exposes a particular command
-lookupPluginId :: CommandId -> IdePlugins a -> Maybe PluginId
-lookupPluginId cmd (IdePlugins ls) = fst <$> find go ls
+lookupPluginId :: [(PluginId, PluginDescriptor a)] -> CommandId -> Maybe PluginId
+lookupPluginId ls cmd = fst <$> find go ls
   where
     go (_, desc) = cmd `elem` map commandId (pluginCommands desc)
 

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

@@ -73,12 +73,20 @@ import           Options.Applicative             (ParserInfo)
 import           System.FilePath
 import           System.IO.Unsafe
 import           Text.Regex.TDFA.Text            ()
+import           Control.Applicative             ((<|>))
 
 -- ---------------------------------------------------------------------
 
-newtype IdePlugins ideState = IdePlugins
-  { ipMap :: [(PluginId, PluginDescriptor ideState)]}
-  deriving newtype (Monoid, Semigroup)
+data IdePlugins ideState = IdePlugins
+  { ipMap :: [(PluginId, PluginDescriptor ideState)]
+  , lookupCommandProvider :: CommandId -> Maybe PluginId
+  }
+
+instance Semigroup (IdePlugins a) where
+  (IdePlugins a f) <> (IdePlugins b g) = IdePlugins (a ++ b) (\x -> f x <|> g x)
+
+instance Monoid (IdePlugins a) where
+  mempty = IdePlugins [] (const Nothing)
 
 -- | Hooks for modifying the 'DynFlags' at different times of the compilation
 -- process. Plugins can install a 'DynFlagsModifications' via