Allow plugins to use GetAnnotatedParsedSource by linking it in when d…

…epended on
haskell · Aug 13, 2022 · 4fcddfc · 4fcddfc
1 parent eec0222
commit 4fcddfc
Show file tree

Hide file tree

Showing 5 changed files with 27 additions and 19 deletions.
diff --git a/exe/Plugins.hs b/exe/Plugins.hs
@@ -177,7 +177,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
       Class.descriptor pluginRecorder "class" :
 #endif
 #if hls_haddockComments
-      HaddockComments.descriptor "haddockComments" :
+      HaddockComments.descriptor pluginRecorder "haddockComments" :
 #endif
 #if hls_eval
       Eval.descriptor pluginRecorder "eval" :

diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs
@@ -31,6 +31,8 @@ import           Development.IDE.Core.PositionMapping (PositionMapping,
                                                        fromCurrentPosition,
                                                        toCurrentRange)
 import           Development.IDE.Types.Logger         (Pretty (..))
+import qualified Development.IDE.GHC.ExactPrint       as E
+import           Development.IDE.Plugin.CodeAction
 import           Ide.Plugin.CodeRange.Rules           (CodeRange (..),
                                                        GetCodeRange (..),
                                                        codeRangeRule)
@@ -55,18 +57,20 @@ import           Language.LSP.Types                   (List (List),
 import           Prelude                              hiding (log, span)
 
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
-descriptor recorder plId = (defaultPluginDescriptor plId)
+descriptor recorder plId = mkExactprintPluginDescriptor (cmapWithPrio LogExactPrint recorder) $ (defaultPluginDescriptor plId)
     { pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler
     -- TODO @sloorush add folding range
     -- <> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler
     , pluginRules = codeRangeRule (cmapWithPrio LogRules recorder)
     }
 
 data Log = LogRules Rules.Log
+         | LogExactPrint E.Log
 
 instance Pretty Log where
     pretty log = case log of
         LogRules codeRangeLog -> pretty codeRangeLog
+        LogExactPrint exactPrintLog -> pretty exactPrintLog
 
 selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))
 selectionRangeHandler ide _ SelectionRangeParams{..} = do

diff --git a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs
@@ -15,17 +15,19 @@ import qualified Data.Map                              as Map
 import qualified Data.Text                             as T
 import           Development.IDE                       hiding (pluginHandlers)
 import           Development.IDE.GHC.Compat
+import           Development.IDE.Plugin.CodeAction
 import           Development.IDE.GHC.Compat.ExactPrint
 import           Development.IDE.GHC.ExactPrint        (GetAnnotatedParsedSource (..))
+import qualified Development.IDE.GHC.ExactPrint                   as E
 import           Ide.Types
 import           Language.Haskell.GHC.ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)
 import           Language.Haskell.GHC.ExactPrint.Utils
 import           Language.LSP.Types
 
 -----------------------------------------------------------------------------
-descriptor :: PluginId -> PluginDescriptor IdeState
-descriptor plId =
+descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
+descriptor recorder plId = mkExactprintPluginDescriptor recorder $
   (defaultPluginDescriptor plId)
     { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider
     }

diff --git a/plugins/hls-haddock-comments-plugin/test/Main.hs b/plugins/hls-haddock-comments-plugin/test/Main.hs
@@ -19,7 +19,7 @@ main :: IO ()
 main = defaultTestRunner tests
 
 haddockCommentsPlugin :: PluginDescriptor IdeState
-haddockCommentsPlugin = HaddockComments.descriptor "haddockComments"
+haddockCommentsPlugin = HaddockComments.descriptor mempty "haddockComments"
 
 tests :: TestTree
 tests =

diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs
@@ -21,6 +21,7 @@
 
 module Development.IDE.Plugin.CodeAction
     (
+    mkExactprintPluginDescriptor,
     iePluginDescriptor,
     typeSigsPluginDescriptor,
     bindingsPluginDescriptor,
@@ -158,39 +159,40 @@ iePluginDescriptor recorder plId =
           , wrap suggestExportUnusedTopBinding
           ]
           plId
-   in old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction
-          , pluginRules = getAnnotatedParsedSourceRule recorder
-          }
+   in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction }
 
 typeSigsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
-typeSigsPluginDescriptor recorder plId =
-  (mkGhcideCAsPlugin [
+typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
+  mkGhcideCAsPlugin [
       wrap $ suggestSignature True
     , wrap suggestFillTypeWildcard
     , wrap removeRedundantConstraints
     , wrap suggestAddTypeAnnotationToSatisfyContraints
     , wrap suggestConstraint
     ]
-    plId) { pluginRules = getAnnotatedParsedSourceRule recorder }
+    plId
 
 bindingsPluginDescriptor :: Recorder (WithPriority E.Log) ->  PluginId -> PluginDescriptor IdeState
-bindingsPluginDescriptor recorder plId =
-  (mkGhcideCAsPlugin [
+bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
+  mkGhcideCAsPlugin [
       wrap suggestReplaceIdentifier
     , wrap suggestImplicitParameter
     , wrap suggestNewDefinition
     , wrap suggestDeleteUnusedBinding
     ]
-    plId) { pluginRules = getAnnotatedParsedSourceRule recorder }
+    plId
 
 fillHolePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
-fillHolePluginDescriptor recorder plId = (mkGhcideCAPlugin (wrap suggestFillHole) plId) { pluginRules = getAnnotatedParsedSourceRule recorder }
+fillHolePluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder (mkGhcideCAPlugin (wrap suggestFillHole) plId)
 
 extendImportPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState
-extendImportPluginDescriptor recorder plId = (defaultPluginDescriptor plId)
-  { pluginCommands = [extendImportCommand]
-  , pluginRules = getAnnotatedParsedSourceRule recorder
-  }
+extendImportPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor plId)
+  { pluginCommands = [extendImportCommand] }
+
+
+-- | Add the ability for a plugin to call GetAnnotatedParsedSource
+mkExactprintPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginDescriptor a -> PluginDescriptor a
+mkExactprintPluginDescriptor recorder desc = desc { pluginRules = pluginRules desc >> getAnnotatedParsedSourceRule recorder }
 
 -------------------------------------------------------------------------------------------------