WIP. Using plugin descriptors, and combining them.

Proof of concept, seems to work in big pieces, needs huge amount of cleanup.

Author: alanz

exe/Main.hs

@@ -52,6 +52,7 @@ import HIE.Bios.Cradle
 import HIE.Bios.Environment
 import HIE.Bios.Types
 import Ide.Plugin
+-- import Ide.PluginDescriptors
 import Ide.Plugin.Config
 -- import Ide.Plugin.Formatter
 import Language.Haskell.LSP.Messages
@@ -79,12 +80,16 @@ import Ide.Plugin.Pragmas                 as Pragmas
 
 -- ---------------------------------------------------------------------
 
--- The plugins configured for use in this instance of the language
+-- | TODO: these should come out of something like asGhcIdePlugin
+commandIds :: T.Text -> [T.Text]
+commandIds pid = "typesignature.add" : allLspCmdIds pid [("pragmas", Pragmas.commands)]
+
+-- | The plugins configured for use in this instance of the language
 -- server.
 -- These can be freely added or removed to tailor the available
 -- features of the server.
-idePlugins :: Bool -> Plugin Config
-idePlugins includeExample
+_idePlugins :: Bool -> Plugin Config
+_idePlugins includeExample
   = Completions.plugin <>
     CodeAction.plugin <>
     formatterPlugins [("ormolu",   Ormolu.provider)
@@ -93,12 +98,44 @@ idePlugins includeExample
                       ,("eg2",     Example2.codeAction)
                       ,("pragmas", Pragmas.codeAction)] <>
     executeCommandPlugins [("pragmas", Pragmas.commands)] <>
-    hoverPlugins [Example.hover, Example2.hover] <>
+    hoverPlugins [("eg", Example.hover)
+                 ,("eg2", Example2.hover)] <>
     if includeExample then Example.plugin <> Example2.plugin
                       else mempty
 
-commandIds :: T.Text -> [T.Text]
-commandIds pid = "typesignature.add" : allLspCmdIds pid [("pragmas", Pragmas.commands)]
+
+-- | The plugins configured for use in this instance of the language
+-- server.
+-- These can be freely added or removed to tailor the available
+-- features of the server.
+idePlugins :: Bool -> Plugin Config
+idePlugins includeExamples
+    = asGhcIdePlugin $ pluginDescToIdePlugins allPlugins
+  where
+    allPlugins = if includeExamples
+                   then basePlugins ++ examplePlugins
+                   else basePlugins
+    basePlugins =
+      [
+      --   applyRefactDescriptor "applyrefact"
+      -- , brittanyDescriptor    "brittany"
+      -- , haddockDescriptor     "haddock"
+      -- -- , hareDescriptor        "hare"
+      -- , hsimportDescriptor    "hsimport"
+      -- , liquidDescriptor      "liquid"
+      -- , packageDescriptor     "package"
+      -- , pragmasDescriptor     "pragmas"
+        Floskell.descriptor "floskell"
+      -- , genericDescriptor     "generic"
+      -- , ghcmodDescriptor      "ghcmod"
+      , Ormolu.descriptor   "ormolu"
+      ]
+    examplePlugins =
+      [Example.descriptor  "eg"
+      ,Example2.descriptor "eg2"
+      -- ,hfaAlignDescriptor "hfaa"
+      ]
+
 
 -- ---------------------------------------------------------------------
 -- Prefix for the cache path

src/Ide/Plugin.hs

@@ -10,6 +10,7 @@
 module Ide.Plugin
     (
       asGhcIdePlugin
+    , pluginDescToIdePlugins
     , formatterPlugins
     , hoverPlugins
     , codeActionPlugins
@@ -29,7 +30,7 @@ import           Data.Maybe
 import qualified Data.Text                     as T
 import           Development.IDE.Core.Rules
 import           Development.IDE.LSP.Server
-import           Development.IDE.Plugin
+import           Development.IDE.Plugin hiding (pluginCommands)
 import           Development.IDE.Types.Diagnostics as D
 import           Development.Shake hiding ( Diagnostic, command )
 import           GHC.Generics
@@ -42,7 +43,6 @@ import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Types
 import qualified Language.Haskell.LSP.Types              as J
 import qualified Language.Haskell.LSP.Types.Capabilities as C
--- import qualified Language.Haskell.LSP.Types.Lens         as J
 import           Language.Haskell.LSP.Types.Lens as L hiding (formatting, rangeFormatting)
 import           Text.Regex.TDFA.Text()
 
@@ -52,32 +52,50 @@ import           Text.Regex.TDFA.Text()
 -- IdePlugins are arranged by kind of operation, 'Plugin' is arranged by message
 -- category ('Notifaction', 'Request' etc).
 asGhcIdePlugin :: IdePlugins -> Plugin Config
-asGhcIdePlugin _ = Plugin mempty mempty mempty
+asGhcIdePlugin mp =
+    mkPlugin executeCommandPlugins (Just . pluginCommands) <>
+    mkPlugin codeActionPlugins     pluginCodeActionProvider <>
+    -- diagnostics from pluginDiagnosticProvider
+    mkPlugin hoverPlugins          pluginHoverProvider <>
+    -- symbols via pluginSymbolProvider
+    mkPlugin formatterPlugins      pluginFormattingProvider
+    -- completions
+    where
+        justs (p, Just x)  = [(p, x)]
+        justs (_, Nothing) = []
 
--- First strp will be to bring the machinery from Ide.Plugin.Formatter over.
+        ls = Map.toList (ipMap mp)
+
+        mkPlugin :: ([(PluginId, b)] -> t) -> (PluginDescriptor -> Maybe b) -> t
+        mkPlugin maker selector
+            = maker $ concatMap (\(pid, p) -> justs (pid, selector p)) ls
+
+
+pluginDescToIdePlugins :: [PluginDescriptor] -> IdePlugins
+pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginId p, p)) plugins
 
 -- ---------------------------------------------------------------------
 
-codeActionPlugins :: [(T.Text, CodeActionProvider)] -> Plugin Config
+codeActionPlugins :: [(PluginId, CodeActionProvider)] -> Plugin Config
 codeActionPlugins cas = Plugin mempty codeActionRules (codeActionHandlers cas)
 
 codeActionRules :: Rules ()
 codeActionRules = mempty
 
-codeActionHandlers :: [(T.Text, CodeActionProvider)] -> PartialHandlers Config
+codeActionHandlers :: [(PluginId, CodeActionProvider)] -> PartialHandlers Config
 codeActionHandlers cas = PartialHandlers $ \WithMessage{..} x -> return x
     { LSP.codeActionHandler
         = withResponse RspCodeAction (makeCodeAction cas)
     }
 
-makeCodeAction :: [(T.Text, CodeActionProvider)]
+makeCodeAction :: [(PluginId, CodeActionProvider)]
       -> LSP.LspFuncs Config -> IdeState
       -> CodeActionParams
       -> IO (Either ResponseError (List CAResult))
 makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do
     let caps = LSP.clientCapabilities lf
         unL (List ls) = ls
-    r <- mapM (\(pid,provider) -> provider ideState (PluginId pid) docId range context) cas
+    r <- mapM (\(pid,provider) -> provider ideState pid docId range context) cas
     let actions = filter wasRequested . concat $ map unL $ rights r
     res <- send caps actions
     return $ Right res
@@ -295,23 +313,23 @@ allLspCmdIds pid commands = concat $ map go commands
 
 -- ---------------------------------------------------------------------
 
-hoverPlugins :: [HoverProvider] -> Plugin Config
+hoverPlugins :: [(PluginId, HoverProvider)] -> Plugin Config
 hoverPlugins hs = Plugin mempty hoverRules (hoverHandlers hs)
 
 hoverRules :: Rules ()
 hoverRules = mempty
 
-hoverHandlers :: [HoverProvider] -> PartialHandlers Config
+hoverHandlers :: [(PluginId, HoverProvider)] -> PartialHandlers Config
 hoverHandlers hps = PartialHandlers $ \WithMessage{..} x ->
   return x{LSP.hoverHandler = withResponse RspHover (makeHover hps)}
 
-makeHover :: [HoverProvider]
+makeHover :: [(PluginId, HoverProvider)]
       -> LSP.LspFuncs Config -> IdeState
       -> TextDocumentPositionParams
       -> IO (Either ResponseError (Maybe Hover))
 makeHover hps _lf ideState params
   = do
-      mhs <- mapM (\p -> p ideState params) hps
+      mhs <- mapM (\(_,p) -> p ideState params) hps
       -- TODO: We should support ServerCapabilities and declare that
       -- we don't support hover requests during initialization if we
       -- don't have any hover providers
@@ -327,7 +345,7 @@ makeHover hps _lf ideState params
 -- ---------------------------------------------------------------------
 -- ---------------------------------------------------------------------
 
-formatterPlugins :: [(T.Text, FormattingProvider IO)] -> Plugin Config
+formatterPlugins :: [(PluginId, FormattingProvider IO)] -> Plugin Config
 formatterPlugins providers
     = Plugin mempty
              formatterRules
@@ -336,7 +354,7 @@ formatterPlugins providers
 formatterRules :: Rules ()
 formatterRules = mempty
 
-formatterHandlers :: Map.Map T.Text (FormattingProvider IO) -> PartialHandlers Config
+formatterHandlers :: Map.Map PluginId (FormattingProvider IO) -> PartialHandlers Config
 formatterHandlers providers = PartialHandlers $ \WithMessage{..} x -> return x
     { LSP.documentFormattingHandler
         = withResponse RspDocumentFormatting (formatting providers)

src/Ide/Plugin/Example.hs

@@ -10,7 +10,8 @@
 
 module Ide.Plugin.Example
   (
-    plugin
+    descriptor
+  , plugin
   , hover
   , codeAction
   ) where
@@ -21,13 +22,13 @@ import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
 import Data.Binary
 import Data.Functor
 import qualified Data.HashMap.Strict as Map
-import Data.Hashable
 import qualified Data.HashSet as HashSet
+import Data.Hashable
 import qualified Data.Text as T
 import Data.Typeable
 import Development.IDE.Core.OfInterest
-import Development.IDE.Core.Rules
 import Development.IDE.Core.RuleTypes
+import Development.IDE.Core.Rules
 import Development.IDE.Core.Service
 import Development.IDE.Core.Shake
 import Development.IDE.LSP.Server
@@ -36,15 +37,30 @@ import Development.IDE.Types.Diagnostics as D
 import Development.IDE.Types.Location
 import Development.IDE.Types.Logger
 import Development.Shake hiding ( Diagnostic )
-import Ide.Types
 import GHC.Generics
+import Ide.Types
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
 import Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------
 
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = PluginDescriptor
+  { pluginId = plId
+  , pluginRules = exampleRules
+  , pluginCommands = []
+  , pluginCodeActionProvider = Just codeAction
+  , pluginDiagnosticProvider = Nothing
+  , pluginHoverProvider = Just hover
+  , pluginSymbolProvider = Nothing
+  , pluginFormattingProvider = Nothing
+  , pluginCompletionProvider = Nothing
+  }
+
+-- ---------------------------------------------------------------------
+
 plugin :: Plugin c
 plugin = Plugin mempty exampleRules handlersExample
          -- <> codeActionPlugin codeAction

src/Ide/Plugin/Example2.hs

@@ -10,7 +10,8 @@
 
 module Ide.Plugin.Example2
   (
-    plugin
+    descriptor
+  , plugin
   , hover
   , codeAction
   ) where
@@ -45,6 +46,21 @@ import Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------
 
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = PluginDescriptor
+  { pluginId = plId
+  , pluginRules = exampleRules
+  , pluginCommands = []
+  , pluginCodeActionProvider = Just codeAction
+  , pluginDiagnosticProvider = Nothing
+  , pluginHoverProvider = Just hover
+  , pluginSymbolProvider = Nothing
+  , pluginFormattingProvider = Nothing
+  , pluginCompletionProvider = Nothing
+  }
+
+-- ---------------------------------------------------------------------
+
 plugin :: Plugin c
 plugin = Plugin mempty exampleRules handlersExample2
          -- <> codeActionPlugin codeAction

src/Ide/Plugin/Floskell.hs

@@ -7,7 +7,8 @@
 
 module Ide.Plugin.Floskell
   (
-    provider
+    descriptor
+  , provider
   )
 where
 
@@ -24,6 +25,21 @@ import           Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------
 
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = PluginDescriptor
+  { pluginId = plId
+  , pluginRules = mempty
+  , pluginCommands = []
+  , pluginCodeActionProvider = Nothing
+  , pluginDiagnosticProvider = Nothing
+  , pluginHoverProvider      = Nothing
+  , pluginSymbolProvider     = Nothing
+  , pluginFormattingProvider = Just provider
+  , pluginCompletionProvider = Nothing
+  }
+
+-- ---------------------------------------------------------------------
+
 -- | Format provider of Floskell.
 -- Formats the given source in either a given Range or the whole Document.
 -- If the provider fails an error is returned that can be displayed to the user.

src/Ide/Plugin/Formatter.hs

@@ -34,7 +34,7 @@ import           Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------
 
-formatting :: Map.Map T.Text (FormattingProvider IO)
+formatting :: Map.Map PluginId (FormattingProvider IO)
            -> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams
            -> IO (Either ResponseError (List TextEdit))
 formatting providers lf ideState
@@ -43,7 +43,7 @@ formatting providers lf ideState
 
 -- ---------------------------------------------------------------------
 
-rangeFormatting :: Map.Map T.Text (FormattingProvider IO)
+rangeFormatting :: Map.Map PluginId (FormattingProvider IO)
                 -> LSP.LspFuncs Config -> IdeState -> DocumentRangeFormattingParams
                 -> IO (Either ResponseError (List TextEdit))
 rangeFormatting providers lf ideState
@@ -52,13 +52,13 @@ rangeFormatting providers lf ideState
 
 -- ---------------------------------------------------------------------
 
-doFormatting :: LSP.LspFuncs Config -> Map.Map T.Text (FormattingProvider IO)
+doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IO)
              -> IdeState -> FormattingType -> Uri -> FormattingOptions
              -> IO (Either ResponseError (List TextEdit))
 doFormatting lf providers ideState ft uri params = do
   mc <- LSP.config lf
   let mf = maybe "none" formattingProvider mc
-  case Map.lookup mf providers of
+  case Map.lookup (PluginId mf) providers of
       Just provider ->
         case uriToFilePath uri of
           Just (toNormalizedFilePath -> fp) -> do

src/Ide/Plugin/Ormolu.hs

@@ -7,7 +7,8 @@
 
 module Ide.Plugin.Ormolu
   (
-    provider
+    descriptor
+  , provider
   )
 where
 
@@ -32,6 +33,21 @@ import           Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------
 
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = PluginDescriptor
+  { pluginId = plId
+  , pluginRules = mempty
+  , pluginCommands = []
+  , pluginCodeActionProvider = Nothing
+  , pluginDiagnosticProvider = Nothing
+  , pluginHoverProvider      = Nothing
+  , pluginSymbolProvider     = Nothing
+  , pluginFormattingProvider = Just provider
+  , pluginCompletionProvider = Nothing
+  }
+
+-- ---------------------------------------------------------------------
+
 provider :: FormattingProvider IO
 #if __GLASGOW_HASKELL__ >= 806
 provider ideState typ contents fp _ = do