Break down ghcide functionality in HLS plugins (#1257)

* Clean up no longer needed handlers * Move some log lines to debug verbosity * Extract type signature code lenses to an HLS plugin This was worth doing to clean up the messy command handlers * Extract the block command handler to an HLS plugin Previously defined together with the type lenses command handler * fix command capability check * Extract completions into an HLS plugin We might want to break them down into multiple HLS plugins later on (local, non local, and module header). * Extract code actions into an HLS plugin * Group ghcide plugins
2024-09-17 11:47:09 +03:00 · 2021-01-25 08:40:35 +00:00 · 2021-01-25 08:40:35 +00:00 · 0c9dd30e38
commit 0c9dd30e38
parent e06469f2b4
14 changed files with 214 additions and 237 deletions
--- a/exe/Plugins.hs
+++ b/exe/Plugins.hs
@ -2,14 +2,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Plugins where

-import           Ide.Types                 (IdePlugins)
+import Ide.Types (IdePlugins)
 import           Ide.PluginUtils           (pluginDescToIdePlugins)

 -- fixed plugins
 import           Ide.Plugin.Example        as Example
 import           Ide.Plugin.Example2       as Example2
 import           Development.IDE           (IdeState)
-import           Development.IDE.Plugin.HLS.GhcIde as GhcIde
+import Development.IDE.Plugin.HLS.GhcIde as GhcIde

 -- haskell-language-server optional plugins

@ -89,53 +89,53 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
                   then basePlugins ++ examplePlugins
                   else basePlugins
    basePlugins =
-      [ GhcIde.descriptor  "ghcide"
+      GhcIde.descriptors ++
 #if pragmas
-      , Pragmas.descriptor  "pragmas"
+      Pragmas.descriptor  "pragmas" :
 #endif
 #if floskell
-      , Floskell.descriptor "floskell"
+      Floskell.descriptor "floskell" :
 #endif
 #if fourmolu
-      , Fourmolu.descriptor "fourmolu"
+      Fourmolu.descriptor "fourmolu" :
 #endif
 #if tactic
-      , Tactic.descriptor "tactic"
+      Tactic.descriptor "tactic" :
 #endif
 #if ormolu
-      , Ormolu.descriptor   "ormolu"
+      Ormolu.descriptor   "ormolu" :
 #endif
 #if stylishHaskell
-      , StylishHaskell.descriptor "stylish-haskell"
+      StylishHaskell.descriptor "stylish-haskell" :
 #endif
 #if retrie
-      , Retrie.descriptor "retrie"
+      Retrie.descriptor "retrie" :
 #endif
 #if AGPL && brittany
-      , Brittany.descriptor "brittany"
+      Brittany.descriptor "brittany" :
 #endif
 #if class
-      , Class.descriptor "class"
+      Class.descriptor "class" :
 #endif
 #if haddockComments
-      , HaddockComments.descriptor "haddockComments"
+      HaddockComments.descriptor "haddockComments" :
 #endif
 #if eval
-      , Eval.descriptor "eval"
+      Eval.descriptor "eval" :
 #endif
 #if importLens
-      , ExplicitImports.descriptor "importLens"
+      ExplicitImports.descriptor "importLens" :
 #endif
 #if moduleName
-      , ModuleName.descriptor "moduleName"
+      ModuleName.descriptor "moduleName" :
 #endif
 #if hlint
-      , Hlint.descriptor "hlint"
+      Hlint.descriptor "hlint" :
 #endif
 #if splice
-      , Splice.descriptor "splice"
+      Splice.descriptor "splice" :
 #endif
-      ]
+      []
    examplePlugins =
      [Example.descriptor  "eg"
      ,Example2.descriptor "eg2"
--- a/ghcide/exe/Main.hs
+++ b/ghcide/exe/Main.hs
@ -87,7 +87,9 @@ main = do

    dir <- IO.getCurrentDirectory

-    let hlsPlugins = pluginDescToIdePlugins [GhcIde.descriptor "ghcide"]
+    let hlsPlugins = pluginDescToIdePlugins $
+            GhcIde.descriptors ++
+            [ Test.blockCommandDescriptor "block-command" | argsTesting]

    pid <- T.pack . show <$> getProcessID
    let hlsPlugin = asGhcIdePlugin hlsPlugins
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@ -173,6 +173,7 @@ library
        Development.IDE.Plugin.HLS
        Development.IDE.Plugin.HLS.GhcIde
        Development.IDE.Plugin.Test
+        Development.IDE.Plugin.TypeLenses

    -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses
    -- the real GHC library and the types are incompatible. Furthermore, when
--- a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs
+++ b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs
@ -4,8 +4,7 @@

 -- | Display information on hover.
 module Development.IDE.LSP.HoverDefinition
-    ( setHandlersHover
-    , setHandlersDefinition
+    ( setHandlersDefinition
    , setHandlersTypeDefinition
    , setHandlersDocHighlight
    -- * For haskell-language-server
@ -38,13 +37,11 @@ foundHover :: (Maybe Range, [T.Text]) -> Maybe Hover
 foundHover (mbRange, contents) =
  Just $ Hover (HoverContents $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator contents) mbRange

-setHandlersDefinition, setHandlersHover, setHandlersTypeDefinition, setHandlersDocHighlight :: PartialHandlers c
+setHandlersDefinition, setHandlersTypeDefinition, setHandlersDocHighlight :: PartialHandlers c
 setHandlersDefinition = PartialHandlers $ \WithMessage{..} x ->
  return x{LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition}
 setHandlersTypeDefinition = PartialHandlers $ \WithMessage{..} x ->
-  return x{LSP.typeDefinitionHandler = withResponse RspDefinition $ const gotoTypeDefinition}
-setHandlersHover      = PartialHandlers $ \WithMessage{..} x ->
-  return x{LSP.hoverHandler      = withResponse RspHover      $ const hover}
+  return x {LSP.typeDefinitionHandler = withResponse RspDefinition $ const gotoTypeDefinition}
 setHandlersDocHighlight = PartialHandlers $ \WithMessage{..} x ->
  return x{LSP.documentHighlightHandler = withResponse RspDocumentHighlights $ const documentHighlight}

--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@ -108,7 +108,7 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
    let PartialHandlers parts =
            initializeRequestHandler <>
            setHandlersIgnore <> -- least important
-            setHandlersDefinition <> setHandlersHover <> setHandlersTypeDefinition <>
+            setHandlersDefinition <> setHandlersTypeDefinition <>
            setHandlersDocHighlight <>
            setHandlersOutline <>
            userHandlers <>
--- a/ghcide/src/Development/IDE/Plugin.hs
+++ b/ghcide/src/Development/IDE/Plugin.hs
@ -1,19 +1,10 @@
 module Development.IDE.Plugin
  ( Plugin(..)
-  , codeActionPlugin
-  , codeActionPluginWithRules
-  , makeLspCommandId
  ) where

 import Data.Default
-import qualified Data.Text as T
 import Development.Shake
 import Development.IDE.LSP.Server
-import Development.IDE.Core.Rules
-import Ide.PluginUtils
-import           Language.Haskell.LSP.Types
-import qualified Language.Haskell.LSP.Core as LSP
-import Language.Haskell.LSP.Messages


 data Plugin c = Plugin
@ -29,29 +20,3 @@ instance Semigroup (Plugin c) where

 instance Monoid (Plugin c) where
    mempty = def
-
-
-codeActionPlugin :: (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
-codeActionPlugin = codeActionPluginWithRules mempty
-
-codeActionPluginWithRules :: Rules () -> (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
-codeActionPluginWithRules rr f = Plugin rr $ PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.codeActionHandler = withResponse RspCodeAction g
-    }
-    where
-      g lsp state (CodeActionParams a b c _) = fmap List <$> f lsp state a b c
-
-- | Prefix to uniquely identify commands sent to the client.  This
-- has two parts
--
-- - A representation of the process id to make sure that a client has
--   unique commands if it is running multiple servers, since some
--   clients have a global command table and get confused otherwise.
--
-- - A string to identify ghcide, to ease integration into
--   haskell-language-server, which routes commands to plugins based
--   on that.
-makeLspCommandId :: T.Text -> IO T.Text
-makeLspCommandId command = do
-    pid <- getProcessID
-    return $ T.pack (show pid) <> ":ghcide:" <> command
--- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@ -7,23 +7,13 @@

 -- | Go to the definition of a variable.
 module Development.IDE.Plugin.CodeAction
-    (
-      plugin
-
-    -- * For haskell-language-server
-    , codeAction
-    , codeLens
-    , rulePackageExports
-    , commandHandler
+    ( descriptor

    -- * For testing
-    , blockCommandId
-    , typeSignatureCommandId
    , matchRegExMultipleImports
    ) where

 import Control.Monad (join, guard)
-import Development.IDE.Plugin
 import Development.IDE.GHC.Compat
 import Development.IDE.Core.Rules
 import Development.IDE.Core.RuleTypes
@ -31,22 +21,19 @@ import Development.IDE.Core.Service
 import Development.IDE.Core.Shake
 import Development.IDE.GHC.Error
 import Development.IDE.GHC.ExactPrint
-import Development.IDE.LSP.Server
 import Development.IDE.Plugin.CodeAction.ExactPrint
 import Development.IDE.Plugin.CodeAction.PositionIndexed
 import Development.IDE.Plugin.CodeAction.RuleTypes
 import Development.IDE.Plugin.CodeAction.Rules
+import Development.IDE.Plugin.TypeLenses (suggestSignature)
 import Development.IDE.Types.Exports
 import Development.IDE.Types.Location
 import Development.IDE.Types.Options
-import Development.Shake (Rules)
 import qualified Data.HashMap.Strict as Map
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.VFS
-import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
 import qualified Data.Rope.UTF16 as Rope
-import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
 import Data.Char
 import Data.Maybe
 import Data.List.Extra
@ -62,33 +49,28 @@ import Control.Applicative ((<|>))
 import Safe (atMay)
 import Bag (isEmptyBag)
 import qualified Data.HashSet as Set
-import Control.Concurrent.Extra (threadDelay, readVar)
+import Control.Concurrent.Extra (readVar)
 import Development.IDE.GHC.Util (printRdrName)
 import Ide.PluginUtils (subRange)
+import Ide.Types

-plugin :: Plugin c
-plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
-
-rules :: Rules ()
-rules = do
-  rulePackageExports
-
-- | a command that blocks forever. Used for testing
-blockCommandId :: T.Text
-blockCommandId = "ghcide.command.block"
-
-typeSignatureCommandId :: T.Text
-typeSignatureCommandId = "typesignature.add"
+descriptor :: PluginId -> PluginDescriptor IdeState
+descriptor plId =
+  (defaultPluginDescriptor plId)
+    { pluginRules = rulePackageExports,
+      pluginCodeActionProvider = Just codeAction
+    }

 -- | Generate code actions.
 codeAction
    :: LSP.LspFuncs c
    -> IdeState
+    -> PluginId
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
-    -> IO (Either ResponseError [CAResult])
-codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs} = do
+    -> IO (Either ResponseError (List CAResult))
+codeAction lsp state _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs} = do
    contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
    let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
        mbFile = toNormalizedFilePath' <$> uriToFilePath uri
@ -122,58 +104,12 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
               <> actions
               <> actions'
               <> caRemoveInvalidExports parsedModule text diag xs uri
-    pure $ Right actions''
+    pure $ Right $ List actions''

 mkCA :: T.Text -> [Diagnostic] -> WorkspaceEdit -> CAResult
 mkCA title diags edit =
  CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List diags) (Just edit) Nothing

-- | Generate code lenses.
-codeLens
-    :: LSP.LspFuncs c
-    -> IdeState
-    -> CodeLensParams
-    -> IO (Either ResponseError (List CodeLens))
-codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
-    commandId <- makeLspCommandId "typesignature.add"
-    fmap (Right . List) $ case uriToFilePath' uri of
-      Just (toNormalizedFilePath' -> filePath) -> do
-        _ <- runAction "codeLens" ideState (use TypeCheck filePath)
-        diag <- getDiagnostics ideState
-        hDiag <- getHiddenDiagnostics ideState
-        pure
-          [ CodeLens _range (Just (Command title commandId (Just $ List [toJSON edit]))) Nothing
-          | (dFile, _, dDiag@Diagnostic{_range=_range}) <- diag ++ hDiag
-          , dFile == filePath
-          , (title, tedit) <- suggestSignature False dDiag
-          , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
-          ]
-      Nothing -> pure []
-
-- | Execute the "typesignature.add" command.
-commandHandler
-    :: LSP.LspFuncs c
-    -> IdeState
-    -> ExecuteCommandParams
-    -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
-commandHandler lsp _ideState ExecuteCommandParams{..}
-    -- _command is prefixed with a process ID, because certain clients
-    -- have a global command registry, and all commands must be
-    -- unique. And there can be more than one ghcide instance running
-    -- at a time against the same client.
-    | T.isSuffixOf blockCommandId _command
-    = do
-        LSP.sendFunc lsp $ NotCustomServer $
-            NotificationMessage "2.0" (CustomServerMethod "ghcide/blocking/command") Null
-        threadDelay maxBound
-        return (Right Null, Nothing)
-    | T.isSuffixOf typeSignatureCommandId _command
-    , Just (List [edit]) <- _arguments
-    , Success wedit <- fromJSON edit
-    = return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
-    | otherwise
-    = return (Right Null, Nothing)
-
 suggestExactAction ::
  ExportsMap ->
  DynFlags ->
@ -783,31 +719,6 @@ suggestFixConstructorImport _ Diagnostic{_range=_range,..}
  = let fixedImport = typ <> "(" <> constructor <> ")"
    in [("Fix import of " <> fixedImport, [TextEdit _range fixedImport])]
  | otherwise = []
-
-suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
-suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
-    | _message =~
-      ("(Top-level binding|Polymorphic local binding|Pattern synonym) with no type signature" :: T.Text) = let
-      signature      = removeInitialForAll
-                     $ T.takeWhile (\x -> x/='*' && x/='•')
-                     $ T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message
-      startOfLine    = Position (_line _start) startCharacter
-      beforeLine     = Range startOfLine startOfLine
-      title          = if isQuickFix then "add signature: " <> signature else signature
-      action         = TextEdit beforeLine $ signature <> "\n" <> T.replicate startCharacter " "
-      in [(title, [action])]
-    where removeInitialForAll :: T.Text -> T.Text
-          removeInitialForAll (T.breakOnEnd " :: " -> (nm, ty))
-              | "forall" `T.isPrefixOf` ty = nm <> T.drop 2 (snd (T.breakOn "." ty))
-              | otherwise                  = nm <> ty
-          startCharacter
-            | "Polymorphic local binding" `T.isPrefixOf` _message
-            = _character _start
-            | otherwise
-            = 0
-
-suggestSignature _ _ = []
-
 -- | Suggests a constraint for a declaration for which a constraint is missing.
 suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
 suggestConstraint df parsedModule diag@Diagnostic {..}
@ -1201,21 +1112,6 @@ matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
 matchRegex message regex = case message =~~ regex of
    Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
    Nothing -> Nothing
-
-setHandlersCodeLens :: PartialHandlers c
-setHandlersCodeLens = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.codeLensHandler =
-        withResponse RspCodeLens codeLens,
-    LSP.executeCommandHandler =
-        withResponseAndRequest
-            RspExecuteCommand
-            ReqApplyWorkspaceEdit
-            commandHandler
-    }
-
-filterNewlines :: T.Text -> T.Text
-filterNewlines = T.concat  . T.lines
-
 unifySpaces :: T.Text -> T.Text
 unifySpaces    = T.unwords . T.words

--- a/ghcide/src/Development/IDE/Plugin/Completions.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions.hs
@ -3,12 +3,11 @@
 #include "ghc-api-version.h"

 module Development.IDE.Plugin.Completions
-    (
-      plugin
-    , getCompletionsLSP
+    ( descriptor
+    , ProduceCompletions(..)
+    , LocalCompletions(..)
+    , NonLocalCompletions(..)
    ) where
-
-import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
 import qualified Language.Haskell.LSP.Core as LSP
 import qualified Language.Haskell.LSP.VFS as VFS
@ -16,8 +15,6 @@ import qualified Language.Haskell.LSP.VFS as VFS
 import Development.Shake.Classes
 import Development.Shake
 import GHC.Generics
-
-import Development.IDE.Plugin
 import Development.IDE.Core.Service
 import Development.IDE.Core.PositionMapping
 import Development.IDE.Plugin.Completions.Logic
@ -27,18 +24,21 @@ import Development.IDE.Core.Shake
 import Development.IDE.GHC.Compat

 import Development.IDE.GHC.Util
-import Development.IDE.LSP.Server
 import TcRnDriver (tcRnImportDecls)
 import Data.Maybe
 import Ide.Plugin.Config (Config (completionSnippetsOn))
 import Ide.PluginUtils (getClientConfig)
+import Ide.Types

 #if defined(GHC_LIB)
 import Development.IDE.Import.DependencyInformation
 #endif

-plugin :: Plugin Config
-plugin = Plugin produceCompletions setHandlersCompletion
+descriptor :: PluginId -> PluginDescriptor IdeState
+descriptor plId = (defaultPluginDescriptor plId)
+  { pluginRules = produceCompletions
+  , pluginCompletionProvider = Just getCompletionsLSP
+  }

 produceCompletions :: Rules ()
 produceCompletions = do
@ -150,7 +150,3 @@ getCompletionsLSP lsp ide
              _ -> return (Completions $ List [])
          _ -> return (Completions $ List [])
      _ -> return (Completions $ List [])
-setHandlersCompletion :: PartialHandlers Config
-setHandlersCompletion = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.completionHandler = withResponse RspCompletion getCompletionsLSP
-    }
--- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@ -49,11 +49,11 @@ import Development.IDE.GHC.Util
 import Outputable (Outputable)
 import qualified Data.Set as Set
 import ConLike
-
 import GhcPlugins (
    flLabel,
    unpackFS)
 import Data.Either (fromRight)
+import Ide.Types(WithSnippets(..))

 -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs

@ -443,8 +443,6 @@ findRecordCompl _ _ _ = []
 ppr :: Outputable a => a -> T.Text
 ppr = T.pack . prettyPrint

-newtype WithSnippets = WithSnippets Bool
-
 toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem
 toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x
  | with && supported = x
--- a/ghcide/src/Development/IDE/Plugin/HLS.hs
+++ b/ghcide/src/Development/IDE/Plugin/HLS.hs
@ -32,8 +32,8 @@ import qualified Language.Haskell.LSP.VFS                as VFS
 import           Text.Regex.TDFA.Text()
 import Development.Shake (Rules)
 import Ide.PluginUtils (getClientConfig, pluginEnabled, getPluginConfig, responseError, getProcessID)
-import Development.IDE.Types.Logger (logInfo)
 import Development.IDE.Core.Tracing
+import Development.IDE.Types.Logger (logDebug)
 import Control.Concurrent.Async (mapConcurrently)

 -- ---------------------------------------------------------------------
@ -156,7 +156,7 @@ makeCodeLens :: [(PluginId, CodeLensProvider IdeState)]
      -> CodeLensParams
      -> IO (Either ResponseError (List CodeLens))
 makeCodeLens cas lf ideState params = do
-    logInfo (ideLogger ideState) "Plugin.makeCodeLens (ideLogger)" -- AZ
+    logDebug (ideLogger ideState) "Plugin.makeCodeLens (ideLogger)" -- AZ
    let
      makeLens (pid, provider) = do
          pluginConfig <- getPluginConfig lf pid
--- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs
+++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs
@ -4,59 +4,43 @@
 -- | Exposes the ghcide features as an HLS plugin
 module Development.IDE.Plugin.HLS.GhcIde
  (
-    descriptor
+    descriptors
  ) where
-
-import Data.Aeson
 import Development.IDE
-import Development.IDE.Plugin as Ghcide
-import Development.IDE.Plugin.Completions as Completions
-import Development.IDE.Plugin.CodeAction as CodeAction
 import Development.IDE.LSP.HoverDefinition
 import Development.IDE.LSP.Outline
 import Ide.PluginUtils
 import Ide.Types
 import Language.Haskell.LSP.Types
 import Text.Regex.TDFA.Text()
+import qualified Development.IDE.Plugin.CodeAction as CodeAction
+import qualified Development.IDE.Plugin.Completions as Completions
+import qualified Development.IDE.Plugin.TypeLenses as TypeLenses
+
+descriptors :: [PluginDescriptor IdeState]
+descriptors =
+  [ descriptor "ghcide-hover-and-symbols",
+    CodeAction.descriptor "ghcide-code-actions",
+    Completions.descriptor "ghcide-completions",
+    TypeLenses.descriptor "ghcide-type-lenses"
+  ]

 -- ---------------------------------------------------------------------

 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId = (defaultPluginDescriptor plId)
-  { pluginCommands = [PluginCommand (CommandId "typesignature.add") "adds a signature" commandAddSignature]
-  , pluginCodeActionProvider = Just codeAction'
-  , pluginCodeLensProvider   = Just codeLens'
-  , pluginHoverProvider      = Just hover'
+  { pluginHoverProvider      = Just hover'
  , pluginSymbolsProvider    = Just symbolsProvider
-  , pluginCompletionProvider = Just getCompletionsLSP
-  , pluginRules              = Ghcide.pluginRules Completions.plugin <> Ghcide.pluginRules CodeAction.plugin
  }

 -- ---------------------------------------------------------------------

 hover' :: HoverProvider IdeState
 hover' ideState params = do
-    logInfo (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ
+    logDebug (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ
    hover ideState params

 -- ---------------------------------------------------------------------
-
-commandAddSignature :: CommandFunction IdeState WorkspaceEdit
-commandAddSignature lf ide params
-    = commandHandler lf ide (ExecuteCommandParams "typesignature.add" (Just (List [toJSON params])) Nothing)
-
-- ---------------------------------------------------------------------
-
-codeAction' :: CodeActionProvider IdeState
-codeAction' lf ide _ doc range context = fmap List <$> codeAction lf ide doc range context
-
-- ---------------------------------------------------------------------
-
-codeLens' :: CodeLensProvider IdeState
-codeLens' lf ide _ params = codeLens lf ide params
-
-- ---------------------------------------------------------------------
-
 symbolsProvider :: SymbolsProvider IdeState
 symbolsProvider ls ide params = do
    ds <- moduleOutline ls ide params
--- a/ghcide/src/Development/IDE/Plugin/Test.hs
+++ b/ghcide/src/Development/IDE/Plugin/Test.hs
@ -5,6 +5,8 @@ module Development.IDE.Plugin.Test
  ( TestRequest(..)
  , WaitForIdeRuleResult(..)
  , plugin
+  , blockCommandDescriptor
+  , blockCommandId
  ) where

 import Control.Monad.STM
@ -32,6 +34,9 @@ import Data.Bifunctor
 import Data.Text (pack, Text)
 import Data.String
 import Development.IDE.Types.Location (fromUri)
+import Control.Concurrent (threadDelay)
+import Ide.Types
+import qualified Language.Haskell.LSP.Core as LSP

 data TestRequest
    = BlockSeconds Seconds           -- ^ :: Null
@ -104,3 +109,20 @@ parseAction "gethieast" fp = Right . isJust <$> use GetHieAst fp
 parseAction "getDependencies" fp = Right . isJust <$> use GetDependencies fp
 parseAction "getFileContents" fp = Right . isJust <$> use GetFileContents fp
 parseAction other _ = return $ Left $ "Cannot parse ide rule: " <> pack (original other)
+
+-- | a command that blocks forever. Used for testing
+blockCommandId :: Text
+blockCommandId = "ghcide.command.block"
+
+blockCommandDescriptor :: PluginId -> PluginDescriptor state
+blockCommandDescriptor plId = (defaultPluginDescriptor plId) {
+    pluginCommands = [PluginCommand (CommandId blockCommandId) "blocks forever" blockCommandHandler]
+}
+
+blockCommandHandler :: CommandFunction state ExecuteCommandParams
+blockCommandHandler lsp _ideState _params
+    = do
+        LSP.sendFunc lsp $ NotCustomServer $
+            NotificationMessage "2.0" (CustomServerMethod "ghcide/blocking/command") Null
+        threadDelay maxBound
+        return (Right Null, Nothing)
--- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs
+++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs
@ -0,0 +1,115 @@
+-- | An HLS plugin to provide code lenses for type signatures
+module Development.IDE.Plugin.TypeLenses
+  ( descriptor,
+    suggestSignature,
+    typeLensCommandId,
+  )
+where
+
+import Data.Aeson.Types (Value (..), toJSON)
+import qualified Data.HashMap.Strict as Map
+import qualified Data.Text as T
+import Development.IDE.Core.RuleTypes (TypeCheck (TypeCheck))
+import Development.IDE.Core.Rules (IdeState, runAction)
+import Development.IDE.Core.Service (getDiagnostics)
+import Development.IDE.Core.Shake (getHiddenDiagnostics, use)
+import Development.IDE.Types.Location
+  ( Position (Position, _character, _line),
+    Range (Range, _end, _start),
+    toNormalizedFilePath',
+    uriToFilePath',
+  )
+import Ide.PluginUtils (mkLspCommand)
+import Ide.Types
+  ( CommandFunction,
+    CommandId (CommandId),
+    PluginCommand (PluginCommand),
+    PluginDescriptor (pluginCodeLensProvider, pluginCommands),
+    PluginId,
+    defaultPluginDescriptor,
+  )
+import qualified Language.Haskell.LSP.Core as LSP
+import Language.Haskell.LSP.Types
+  ( ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
+    CodeLens (CodeLens),
+    CodeLensParams (CodeLensParams, _textDocument),
+    Diagnostic (..),
+    List (..),
+    ResponseError,
+    ServerMethod (WorkspaceApplyEdit),
+    TextDocumentIdentifier (TextDocumentIdentifier),
+    TextEdit (TextEdit),
+    WorkspaceEdit (WorkspaceEdit),
+  )
+import Text.Regex.TDFA ((=~))
+
+typeLensCommandId :: T.Text
+typeLensCommandId = "typesignature.add"
+
+descriptor :: PluginId -> PluginDescriptor IdeState
+descriptor plId =
+  (defaultPluginDescriptor plId)
+    { pluginCodeLensProvider = Just codeLensProvider,
+      pluginCommands = [PluginCommand (CommandId typeLensCommandId) "adds a signature" commandHandler]
+    }
+
+codeLensProvider ::
+  LSP.LspFuncs c ->
+  IdeState ->
+  PluginId ->
+  CodeLensParams ->
+  IO (Either ResponseError (List CodeLens))
+codeLensProvider _lsp ideState pId CodeLensParams {_textDocument = TextDocumentIdentifier uri} = do
+  fmap (Right . List) $ case uriToFilePath' uri of
+    Just (toNormalizedFilePath' -> filePath) -> do
+      _ <- runAction "codeLens" ideState (use TypeCheck filePath)
+      diag <- getDiagnostics ideState
+      hDiag <- getHiddenDiagnostics ideState
+      sequence
+        [ generateLens pId _range title edit
+          | (dFile, _, dDiag@Diagnostic {_range = _range}) <- diag ++ hDiag,
+            dFile == filePath,
+            (title, tedit) <- suggestSignature False dDiag,
+            let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
+        ]
+    Nothing -> pure []
+
+generateLens :: PluginId -> Range -> T.Text -> WorkspaceEdit -> IO CodeLens
+generateLens pId _range title edit = do
+  cId <- mkLspCommand pId (CommandId typeLensCommandId) title (Just [toJSON edit])
+  return $ CodeLens _range (Just cId) Nothing
+
+commandHandler :: CommandFunction IdeState WorkspaceEdit
+commandHandler _lsp _ideState wedit =
+    return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
+
+suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
+suggestSignature isQuickFix Diagnostic {_range = _range@Range {..}, ..}
+  | _message
+      =~ ("(Top-level binding|Polymorphic local binding|Pattern synonym) with no type signature" :: T.Text) =
+    let signature =
+          removeInitialForAll $
+            T.takeWhile (\x -> x /= '*' && x /= '•') $
+              T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message
+        startOfLine = Position (_line _start) startCharacter
+        beforeLine = Range startOfLine startOfLine
+        title = if isQuickFix then "add signature: " <> signature else signature
+        action = TextEdit beforeLine $ signature <> "\n" <> T.replicate startCharacter " "
+     in [(title, [action])]
+  where
+    removeInitialForAll :: T.Text -> T.Text
+    removeInitialForAll (T.breakOnEnd " :: " -> (nm, ty))
+      | "forall" `T.isPrefixOf` ty = nm <> T.drop 2 (snd (T.breakOn "." ty))
+      | otherwise = nm <> ty
+    startCharacter
+      | "Polymorphic local binding" `T.isPrefixOf` _message =
+        _character _start
+      | otherwise =
+        0
+suggestSignature _ _ = []
+
+unifySpaces :: T.Text -> T.Text
+unifySpaces = T.unwords . T.words
+
+filterNewlines :: T.Text -> T.Text
+filterNewlines = T.concat . T.lines
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@ -28,6 +28,7 @@ import Development.IDE.Core.Shake (Q(..))
 import Development.IDE.GHC.Util
 import qualified Data.Text as T
 import Data.Typeable
+import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
 import Development.IDE.Spans.Common
 import Development.IDE.Test
 import Development.IDE.Test.Runfiles
@ -59,8 +60,8 @@ import Test.Tasty.Ingredients.Rerun
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 import System.Time.Extra
-import Development.IDE.Plugin.CodeAction (typeSignatureCommandId, blockCommandId, matchRegExMultipleImports)
-import Development.IDE.Plugin.Test (WaitForIdeRuleResult(..), TestRequest(BlockSeconds,GetInterfaceFilesDir))
+import Development.IDE.Plugin.CodeAction (matchRegExMultipleImports)
+import Development.IDE.Plugin.Test (TestRequest (BlockSeconds, GetInterfaceFilesDir), WaitForIdeRuleResult (..), blockCommandId)
 import Control.Monad.Extra (whenJust)
 import qualified Language.Haskell.LSP.Types.Lens as L
 import Control.Lens ((^.))
@ -141,7 +142,7 @@ initializeResponseTests = withResource acquire release tests where
    , chk "NO doc link"               _documentLinkProvider  Nothing
    , chk "NO color"                         _colorProvider (Just $ ColorOptionsStatic False)
    , chk "NO folding range"          _foldingRangeProvider (Just $ FoldingRangeOptionsStatic False)
-    , che "   execute command"      _executeCommandProvider (Just $ ExecuteCommandOptions $ List [typeSignatureCommandId, blockCommandId])
+    , che "   execute command"      _executeCommandProvider [blockCommandId, typeLensCommandId]
    , chk "   workspace"                         _workspace (Just $ WorkspaceOptions (Just WorkspaceFolderOptions{_supported = Just True, _changeNotifications = Just ( WorkspaceFolderChangeNotificationsBool True )}))
    , chk "NO experimental"                   _experimental  Nothing
    ] where
@ -157,13 +158,13 @@ initializeResponseTests = withResource acquire release tests where
      chk title getActual expected =
        testCase title $ getInitializeResponse >>= \ir -> expected @=? (getActual . innerCaps) ir

-      che :: TestName -> (InitializeResponseCapabilitiesInner -> Maybe ExecuteCommandOptions) -> Maybe ExecuteCommandOptions -> TestTree
-      che title getActual _expected = testCase title doTest
+      che :: TestName -> (InitializeResponseCapabilitiesInner -> Maybe ExecuteCommandOptions) -> [T.Text] -> TestTree
+      che title getActual expected = testCase title doTest
        where
            doTest = do
                ir <- getInitializeResponse
-                let Just ExecuteCommandOptions {_commands = List [command]} = getActual $ innerCaps ir
-                True @=? T.isSuffixOf "typesignature.add" command
+                let Just ExecuteCommandOptions {_commands = List commands} = getActual $ innerCaps ir
+                zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) expected commands


  innerCaps :: InitializeResponse -> InitializeResponseCapabilitiesInner
@ -1171,7 +1172,7 @@ extendImportTests = testGroup "extend import actions"
                    , "import ModuleA (A (Constructor))"
                    , "b :: A"
                    , "b = Constructor"
-                    ])        
+                    ])
        , testSession "extend single line import with constructor (with comments)" $ template
            [("ModuleA.hs", T.unlines
                    [ "module ModuleA where"