diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index 9bbc376f66..5eed650a17 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -13,8 +13,6 @@ descriptor recorder plId = (defaultPluginDescriptor plId) , pluginRules = rules recorder , pluginHandlers = mkPluginHandler STextDocumentCodeAction (codeAction recorder) <> mkPluginHandler STextDocumentCodeLens codeLens - , pluginConfigDescriptor = - defaultConfigDescriptor { configCustomConfig = mkCustomConfig properties } } commands :: PluginId -> [PluginCommand IdeState] diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs index 5ea74fe780..042c46c52b 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs @@ -23,41 +23,39 @@ import Language.LSP.Types import qualified Language.LSP.Types.Lens as J codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens -codeLens state plId CodeLensParams{..} = do - enabled <- enableTypeLens <$> getCompletionsConfig plId - if not enabled then pure $ pure $ List [] else pluginResponse $ do - nfp <- getNormalizedFilePath plId uri - tmr <- handleMaybeM "Unable to typecheck" - $ liftIO - $ runAction "classplugin.TypeCheck" state - $ use TypeCheck nfp - - -- All instance binds - InstanceBindTypeSigsResult allBinds <- - handleMaybeM "Unable to get InstanceBindTypeSigsResult" - $ liftIO - $ runAction "classplugin.GetInstanceBindTypeSigs" state - $ use GetInstanceBindTypeSigs nfp - - pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs - - let (hsGroup, _, _, _) = tmrRenamed tmr - tycls = hs_tyclds hsGroup - -- declared instance methods without signatures - bindInfos = [ bind - | instds <- map group_instds tycls -- class instance decls - , instd <- instds - , inst <- maybeToList $ getClsInstD (unLoc instd) - , bind <- getBindSpanWithoutSig inst - ] - targetSigs = matchBind bindInfos allBinds - makeLens (range, title) = - generateLens plId range title - $ workspaceEdit pragmaInsertion - $ makeEdit range title - codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs - - pure $ List codeLens +codeLens state plId CodeLensParams{..} = pluginResponse $ do + nfp <- getNormalizedFilePath plId uri + tmr <- handleMaybeM "Unable to typecheck" + $ liftIO + $ runAction "classplugin.TypeCheck" state + $ use TypeCheck nfp + + -- All instance binds + InstanceBindTypeSigsResult allBinds <- + handleMaybeM "Unable to get InstanceBindTypeSigsResult" + $ liftIO + $ runAction "classplugin.GetInstanceBindTypeSigs" state + $ use GetInstanceBindTypeSigs nfp + + pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs + + let (hsGroup, _, _, _) = tmrRenamed tmr + tycls = hs_tyclds hsGroup + -- declared instance methods without signatures + bindInfos = [ bind + | instds <- map group_instds tycls -- class instance decls + , instd <- instds + , inst <- maybeToList $ getClsInstD (unLoc instd) + , bind <- getBindSpanWithoutSig inst + ] + targetSigs = matchBind bindInfos allBinds + makeLens (range, title) = + generateLens plId range title + $ workspaceEdit pragmaInsertion + $ makeEdit range title + codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs + + pure $ List codeLens where uri = _textDocument ^. J.uri diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index 15ba17c2b2..dc2128397d 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -5,7 +5,6 @@ module Ide.Plugin.Class.ExactPrint where -import Control.Lens (Identity) import Control.Monad.Trans.Maybe import qualified Data.Text as T import Development.IDE.GHC.Compat diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index 988c226c1b..b572549325 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -20,11 +19,7 @@ import Development.IDE.GHC.Compat hiding ((<+>)) import Development.IDE.Graph.Classes import GHC.Generics import Ide.Plugin.Class.Utils -import Ide.Plugin.Config -import Ide.Plugin.Properties -import Ide.PluginUtils import Ide.Types -import Language.LSP.Server typeLensCommandId :: CommandId typeLensCommandId = "classplugin.typelens" @@ -112,19 +107,3 @@ rules recorder = do (prettyBindingNameString (printOutputable name) <> " :: " <> T.pack (showDoc ty)) Nothing instanceBindType _ _ = pure Nothing - -properties :: Properties - '[ 'PropertyKey "typelensOn" 'TBoolean] -properties = emptyProperties - & defineBooleanProperty #typelensOn - "Enable type lens on instance methods" - True - -getCompletionsConfig :: (MonadLsp Config m) => PluginId -> m ClassConfig -getCompletionsConfig plId = - ClassConfig - <$> usePropertyLsp #typelensOn plId properties - -newtype ClassConfig = ClassConfig - { enableTypeLens :: Bool - } diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index 2b74979c7a..b15efb7498 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -92,15 +92,6 @@ codeLensTests recorder = testGroup [ "(==) :: B -> B -> Bool" , "(==) :: A -> A -> Bool" ] - , testCase "Should no lens if disabled" $ do - runSessionWithServer (classPlugin recorder) testDataDir $ do - sendConfigurationChanged - $ toJSON - $ def { Plugin.plugins = [("class", def { plcConfig = "typelensOn" .= False })] } - doc <- openDoc "CodeLensSimple.hs" "haskell" - lens <- getCodeLenses doc - let titles = map (^. J.title) $ mapMaybe (^. J.command) lens - liftIO $ titles @?= [] , goldenCodeLens recorder "Apply code lens" "CodeLensSimple" 1 , goldenCodeLens recorder "Apply code lens for local class" "LocalClassDefine" 0 , goldenCodeLens recorder "Apply code lens on the same line" "Inline" 0