From 343357f8a178f4607879b9a837be92de874baf45 Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 10:13:57 -0400 Subject: [PATCH 01/10] Add new PluginUtility function. Add the function `throwPluginError`. This function is intended to provide a common `ResponseError` message for use in logging. Renamed `response` to `pluginResponse` for more clarity. --- exe/Plugins.hs | 4 +- hls-plugin-api/src/Ide/PluginUtils.hs | 12 +++-- .../src/Ide/Plugin/AlternateNumberFormat.hs | 17 ++++--- .../src/Ide/Plugin/CallHierarchy.hs | 4 +- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 48 ++++++++++--------- .../src/Ide/Plugin/ChangeTypeSignature.hs | 4 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 12 ++--- .../src/Ide/Plugin/Rename.hs | 7 +-- .../src/Ide/Plugin/Retrie.hs | 6 +-- .../src/Ide/Plugin/SelectionRange.hs | 4 +- 10 files changed, 66 insertions(+), 52 deletions(-) diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 05ccc8fb20..8efe0b28a7 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -153,7 +153,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins Brittany.descriptor "brittany" : #endif #if callHierarchy - CallHierarchy.descriptor "callHierarchy": + CallHierarchy.descriptor : #endif #if class Class.descriptor "class" : @@ -183,7 +183,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins Splice.descriptor "splice" : #endif #if alternateNumberFormat - AlternateNumberFormat.descriptor pluginRecorder "alternateNumberFormat" : + AlternateNumberFormat.descriptor pluginRecorder : #endif #if selectionRange SelectionRange.descriptor "selectionRange" : diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 8dc33fbdbe..3109d6a7c9 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -28,9 +28,10 @@ module Ide.PluginUtils positionInRange, usePropertyLsp, getNormalizedFilePath, - response, + pluginResponse, handleMaybe, handleMaybeM, + throwPluginError ) where @@ -255,13 +256,18 @@ getNormalizedFilePath (PluginId plId) docId = handleMaybe errMsg uri' = docId ^. uri -- --------------------------------------------------------------------- +throwPluginError :: Monad m => PluginId -> String -> String -> ExceptT String m b +throwPluginError who what where' = throwE msg + where + msg = show who <> " failed with "<> what <> " at " <> where' + handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b handleMaybe msg = maybe (throwE msg) return handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b handleMaybeM msg act = maybeM (throwE msg) return $ lift act -response :: Monad m => ExceptT String m a -> m (Either ResponseError a) -response = +pluginResponse :: Monad m => ExceptT String m a -> m (Either ResponseError a) +pluginResponse = fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing)) . runExceptT diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 4491f96fb9..407a8b46ec 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -14,9 +14,8 @@ import Development.IDE (GetParsedModule (GetParsedModu GhcSession (GhcSession), IdeState, RuleResult, Rules, define, getFileContents, - hscEnv, ideLogger, - realSrcSpanToRange, runAction, - use, useWithStale) + hscEnv, realSrcSpanToRange, + runAction, use, useWithStale) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (getSrcSpan) import Development.IDE.GHC.Compat.Util (toList) @@ -32,7 +31,8 @@ import Ide.Plugin.Conversion (AlternateFormat, alternateFormat) import Ide.Plugin.Literals import Ide.PluginUtils (handleMaybe, handleMaybeM, - response) + pluginResponse, + throwPluginError) import Ide.Types import Language.LSP.Types import Language.LSP.Types.Lens (uri) @@ -43,8 +43,11 @@ instance Pretty Log where pretty = \case LogShake log -> pretty log -descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = (defaultPluginDescriptor plId) +alternateNumberFormatId :: PluginId +alternateNumberFormatId = "alternateNumberFormat" + +descriptor :: Recorder (WithPriority Log) -> PluginDescriptor IdeState +descriptor recorder = (defaultPluginDescriptor alternateNumberFormatId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler , pluginRules = collectLiteralsRule recorder } @@ -84,7 +87,7 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $ do +codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do nfp <- getNormalizedFilePath docId CLR{..} <- requestLiterals state nfp pragma <- getFirstPragma state nfp diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy.hs index ce21a79454..0a0242376d 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy.hs @@ -5,8 +5,8 @@ import qualified Ide.Plugin.CallHierarchy.Internal as X import Ide.Types import Language.LSP.Types -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) +descriptor :: PluginDescriptor IdeState +descriptor = (defaultPluginDescriptor X.callHierarchyId) { Ide.Types.pluginHandlers = mkPluginHandler STextDocumentPrepareCallHierarchy X.prepareCallHierarchy <> mkPluginHandler SCallHierarchyIncomingCalls X.incomingCalls <> mkPluginHandler SCallHierarchyOutgoingCalls X.outgoingCalls diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index f258412a6a..6a41361df8 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -11,6 +11,7 @@ module Ide.Plugin.CallHierarchy.Internal ( prepareCallHierarchy , incomingCalls , outgoingCalls +, callHierarchyId ) where import Control.Lens ((^.)) @@ -35,23 +36,25 @@ import GHC.Conc.Sync import HieDb (Symbol (Symbol)) import qualified Ide.Plugin.CallHierarchy.Query as Q import Ide.Plugin.CallHierarchy.Types +import Ide.PluginUtils (getNormalizedFilePath, + handleMaybe, pluginResponse, + throwPluginError) import Ide.Types import Language.LSP.Types import qualified Language.LSP.Types.Lens as L import Text.Read (readMaybe) +callHierarchyId :: PluginId +callHierarchyId = PluginId "callHierarchy" + -- | Render prepare call hierarchy request. prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHierarchy -prepareCallHierarchy state pluginId param - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = - liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp pos)) >>= - \case - Just items -> pure $ Right $ Just $ List items - Nothing -> pure $ Right Nothing - | otherwise = pure $ Left $ responseError $ T.pack $ "Call Hierarchy: uriToNormalizedFilePath failed for: " <> show uri - where - uri = param ^. (L.textDocument . L.uri) - pos = param ^. L.position +prepareCallHierarchy state pluginId param = pluginResponse $ do + nfp <- getNormalizedFilePath pluginId (param ^. L.textDocument) + items <- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp (param ^. L.position))) + case items of + Just items -> pure $ Just $ List items + Nothing -> pure Nothing prepareCallHierarchyItem :: NormalizedFilePath -> Position -> Action (Maybe [CallHierarchyItem]) prepareCallHierarchyItem = constructFromAst @@ -196,13 +199,14 @@ deriving instance Ord Value -- | Render incoming calls request. incomingCalls :: PluginMethodHandler IdeState CallHierarchyIncomingCalls -incomingCalls state pluginId param = do - liftIO $ runAction "CallHierarchy.incomingCalls" state $ +incomingCalls state pluginId param = pluginResponse $ do + calls <- liftIO $ runAction "CallHierarchy.incomingCalls" state $ queryCalls (param ^. L.item) Q.incomingCalls mkCallHierarchyIncomingCall - mergeIncomingCalls >>= - \case - Just x -> pure $ Right $ Just $ List x - Nothing -> pure $ Left $ responseError "CallHierarchy: IncomingCalls internal error" + mergeIncomingCalls + x <- case calls of + Just x -> pure x + Nothing -> throwPluginError callHierarchyId "Internal Error" "incomingCalls" + pure $ Just $ List x where mkCallHierarchyIncomingCall :: Vertex -> Action (Maybe CallHierarchyIncomingCall) mkCallHierarchyIncomingCall = mkCallHierarchyCall CallHierarchyIncomingCall @@ -217,13 +221,13 @@ incomingCalls state pluginId param = do -- Render outgoing calls request. outgoingCalls :: PluginMethodHandler IdeState CallHierarchyOutgoingCalls -outgoingCalls state pluginId param = do - liftIO $ runAction "CallHierarchy.outgoingCalls" state $ +outgoingCalls state pluginId param = pluginResponse $ do + calls <- liftIO $ runAction "CallHierarchy.outgoingCalls" state $ queryCalls (param ^. L.item) Q.outgoingCalls mkCallHierarchyOutgoingCall - mergeOutgoingCalls >>= - \case - Just x -> pure $ Right $ Just $ List x - Nothing -> pure $ Left $ responseError "CallHierarchy: OutgoingCalls internal error" + mergeOutgoingCalls + case calls of + Just x -> pure $ Just $ List x + Nothing -> throwPluginError callHierarchyId "Internal Error" "outgoingCalls" where mkCallHierarchyOutgoingCall :: Vertex -> Action (Maybe CallHierarchyOutgoingCall) mkCallHierarchyOutgoingCall = mkCallHierarchyCall CallHierarchyOutgoingCall diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index 3d833a9cd5..a8b4aa14e8 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -22,7 +22,7 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Util (printOutputable) import Generics.SYB (extQ, something) import Ide.PluginUtils (getNormalizedFilePath, - handleMaybeM, response) + handleMaybeM, pluginResponse) import Ide.Types (PluginDescriptor (..), PluginId, PluginMethodHandler, defaultPluginDescriptor, @@ -34,7 +34,7 @@ descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler } codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = response $ do +codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = pluginResponse $ do nfp <- getNormalizedFilePath plId (TextDocumentIdentifier uri) decls <- getDecls ideState nfp let actions = mapMaybe (generateAction uri decls) diags diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 70d7c7d130..1251a72b5e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -48,14 +48,13 @@ import Development.IDE (GetModSummary (..), GhcSessionIO (..), IdeState, ModSummaryResult (..), NeedsCompilation (NeedsCompilation), - evalGhcEnv, + VFSModified (..), evalGhcEnv, hscEnvWithImportPaths, printOutputable, runAction, textToStringBuffer, toNormalizedFilePath', uriToFilePath', useNoFile_, - useWithStale_, use_, - VFSModified(..)) + useWithStale_, use_) import Development.IDE.Core.Rules (GhcSessionDepsConfig (..), ghcSessionDepsDefinition) import Development.IDE.GHC.Compat hiding (typeKind, unitState) @@ -91,7 +90,8 @@ import Ide.Plugin.Eval.Code (Statement, asStatements, evalSetup, myExecStmt, propSetup, resultRange, testCheck, testRanges) -import Ide.Plugin.Eval.Config (getEvalConfig, EvalConfig(..)) +import Ide.Plugin.Eval.Config (EvalConfig (..), + getEvalConfig) import Ide.Plugin.Eval.GHC (addImport, addPackages, hasPackage, showDynFlags) import Ide.Plugin.Eval.Parse.Comments (commentsToSections) @@ -101,7 +101,7 @@ import Ide.Plugin.Eval.Types import Ide.Plugin.Eval.Util (gStrictTry, isLiterate, logWith, response', timed) import Ide.PluginUtils (handleMaybe, handleMaybeM, - response) + pluginResponse) import Ide.Types import Language.LSP.Server import Language.LSP.Types hiding @@ -127,7 +127,7 @@ codeLens st plId CodeLensParams{_textDocument} = let dbg = logWith st perf = timed dbg in perf "codeLens" $ - response $ do + pluginResponse $ do let TextDocumentIdentifier uri = _textDocument fp <- handleMaybe "uri" $ uriToFilePath' uri let nfp = toNormalizedFilePath' fp diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 1777872f2a..6d051d96de 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -12,7 +12,8 @@ module Ide.Plugin.Rename (descriptor) where #if MIN_VERSION_ghc(9,2,1) -import GHC.Parser.Annotation (AnnContext, AnnList, AnnParen, AnnPragma) +import GHC.Parser.Annotation (AnnContext, AnnList, + AnnParen, AnnPragma) #endif import Control.Monad @@ -20,9 +21,9 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Except import Data.Generics +import Data.Hashable import Data.HashSet (HashSet) import qualified Data.HashSet as HS -import Data.Hashable import Data.List.Extra import qualified Data.Map as M import Data.Maybe @@ -63,7 +64,7 @@ descriptor pluginId = (defaultPluginDescriptor pluginId) renameProvider :: PluginMethodHandler IdeState TextDocumentRename renameProvider state pluginId (RenameParams (TextDocumentIdentifier uri) pos _prog newNameText) = - response $ do + pluginResponse $ do nfp <- safeUriToNfp uri oldName <- getNameAtPos state nfp pos refLocs <- refsAtName state nfp oldName diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 8075282807..8c1ddecf55 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -37,9 +37,9 @@ import Data.Bifunctor (Bifunctor (first), import qualified Data.ByteString as BS import Data.Coerce import Data.Either (partitionEithers) +import Data.Hashable (unhashed) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as Set -import Data.Hashable (unhashed) import Data.IORef.Extra (atomicModifyIORef'_, newIORef, readIORef) import Data.List.Extra (find, nubOrdOn) @@ -101,9 +101,9 @@ import qualified Retrie.GHC as GHC import Retrie.Monad (addImports, apply, getGroundTerms, runRetrie) +import qualified Retrie.Options as Retrie import Retrie.Options (defaultOptions, getTargetFiles) -import qualified Retrie.Options as Retrie import Retrie.Replace (Change (..), Replacement (..)) import Retrie.Rewrites @@ -188,7 +188,7 @@ extractImports _ _ _ = [] ------------------------------------------------------------------------------- provider :: PluginMethodHandler IdeState TextDocumentCodeAction -provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) = response $ do +provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) = pluginResponse $ do let (J.CodeActionContext _diags _monly) = ca nuri = toNormalizedUri uri nfp <- handleMaybe "uri" $ uriToNormalizedFilePath nuri diff --git a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs index 3e25e41b55..35e6009be7 100644 --- a/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs +++ b/plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs @@ -37,7 +37,7 @@ import Development.IDE.GHC.Compat (HieAST (Node), Span, import Development.IDE.GHC.Compat.Util import Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (PreProcessEnv), preProcessAST) -import Ide.PluginUtils (response) +import Ide.PluginUtils (pluginResponse) import Ide.Types (PluginDescriptor (pluginHandlers), PluginId, defaultPluginDescriptor, @@ -62,7 +62,7 @@ descriptor plId = (defaultPluginDescriptor plId) selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange)) selectionRangeHandler ide _ SelectionRangeParams{..} = do liftIO $ logDebug logger $ "requesting selection range for file: " <> T.pack (show uri) - response $ do + pluginResponse $ do filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $ toNormalizedFilePath' <$> uriToFilePath' uri selectionRanges <- ExceptT . liftIO . runIdeAction "SelectionRange" (shakeExtras ide) . runExceptT $ From bc5d499eb276e455ce1b11e856ba0a3b6d16131a Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 10:31:58 -0400 Subject: [PATCH 02/10] Call hierarchy clean up --- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index 6a41361df8..17770ff18f 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -52,9 +52,7 @@ prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHier prepareCallHierarchy state pluginId param = pluginResponse $ do nfp <- getNormalizedFilePath pluginId (param ^. L.textDocument) items <- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp (param ^. L.position))) - case items of - Just items -> pure $ Just $ List items - Nothing -> pure Nothing + pure (List <$> items) prepareCallHierarchyItem :: NormalizedFilePath -> Position -> Action (Maybe [CallHierarchyItem]) prepareCallHierarchyItem = constructFromAst @@ -203,10 +201,9 @@ incomingCalls state pluginId param = pluginResponse $ do calls <- liftIO $ runAction "CallHierarchy.incomingCalls" state $ queryCalls (param ^. L.item) Q.incomingCalls mkCallHierarchyIncomingCall mergeIncomingCalls - x <- case calls of - Just x -> pure x - Nothing -> throwPluginError callHierarchyId "Internal Error" "incomingCalls" - pure $ Just $ List x + case calls of + Just x -> pure $ Just $ List x + Nothing -> throwPluginError callHierarchyId "Internal Error" "incomingCalls" where mkCallHierarchyIncomingCall :: Vertex -> Action (Maybe CallHierarchyIncomingCall) mkCallHierarchyIncomingCall = mkCallHierarchyCall CallHierarchyIncomingCall From ea84a5d827d9b9636a678e251982cf77568629ca Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 12:14:56 -0400 Subject: [PATCH 03/10] Make Descriptor usable as String/Text or PluginID --- .../src/Ide/Plugin/AlternateNumberFormat.hs | 20 ++++++++----------- .../src/Ide/Plugin/ChangeTypeSignature.hs | 14 ++++++++----- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 407a8b46ec..889b8add30 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -8,6 +8,7 @@ module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where import Control.Lens ((^.)) import Control.Monad.Except (ExceptT, MonadIO, liftIO) import qualified Data.HashMap.Strict as HashMap +import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import Development.IDE (GetParsedModule (GetParsedModule), @@ -30,7 +31,8 @@ import Ide.Plugin.Conversion (AlternateFormat, ExtensionNeeded (NeedsExtension, NoExtension), alternateFormat) import Ide.Plugin.Literals -import Ide.PluginUtils (handleMaybe, handleMaybeM, +import Ide.PluginUtils (getNormalizedFilePath, + handleMaybe, handleMaybeM, pluginResponse, throwPluginError) import Ide.Types @@ -43,7 +45,7 @@ instance Pretty Log where pretty = \case LogShake log -> pretty log -alternateNumberFormatId :: PluginId +alternateNumberFormatId :: IsString a => a alternateNumberFormatId = "alternateNumberFormat" descriptor :: Recorder (WithPriority Log) -> PluginDescriptor IdeState @@ -88,7 +90,7 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do - nfp <- getNormalizedFilePath docId + nfp <- getNormalizedFilePath alternateNumberFormatId docId CLR{..} <- requestLiterals state nfp pragma <- getFirstPragma state nfp -- remove any invalid literals (see validTarget comment) @@ -148,20 +150,14 @@ p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p getFirstPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do - ghcSession <- liftIO $ runAction "AlternateNumberFormat.GhcSession" state $ useWithStale GhcSession nfp - (_, fileContents) <- liftIO $ runAction "AlternateNumberFormat.GetFileContents" state $ getFileContents nfp + ghcSession <- liftIO $ runAction (alternateNumberFormatId <> ".GhcSession") state $ useWithStale GhcSession nfp + (_, fileContents) <- liftIO $ runAction (alternateNumberFormatId <> ".GetFileContents") state $ getFileContents nfp case ghcSession of Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents Nothing -> pure Nothing - -getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath -getNormalizedFilePath docId = handleMaybe "Error: converting to NormalizedFilePath" - $ uriToNormalizedFilePath - $ toNormalizedUri (docId ^. uri) - requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult requestLiterals state = handleMaybeM "Error: Could not Collect Literals" . liftIO - . runAction "AlternateNumberFormat.CollectLiterals" state + . runAction (alternateNumberFormatId <> ".CollectLiterals") state . use CollectLiterals diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index a8b4aa14e8..c20138c1fd 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -12,6 +12,7 @@ import Control.Monad.Trans.Except (ExceptT) import Data.Foldable (asum) import qualified Data.HashMap.Strict as Map import Data.Maybe (mapMaybe) +import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import Development.IDE (realSrcSpanToRange) @@ -24,14 +25,17 @@ import Generics.SYB (extQ, something) import Ide.PluginUtils (getNormalizedFilePath, handleMaybeM, pluginResponse) import Ide.Types (PluginDescriptor (..), - PluginId, PluginMethodHandler, + PluginMethodHandler, defaultPluginDescriptor, mkPluginHandler) import Language.LSP.Types import Text.Regex.TDFA ((=~)) -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler } +changeTypeSignatureId :: IsString a => a +changeTypeSignatureId = "changeTypeSignature" + +descriptor :: PluginDescriptor IdeState +descriptor = (defaultPluginDescriptor changeTypeSignatureId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler } codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction codeActionHandler ideState plId CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext (List diags) _} = pluginResponse $ do @@ -44,7 +48,7 @@ getDecls :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m [LHs getDecls state = handleMaybeM "Error: Could not get Parsed Module" . liftIO . fmap (fmap (hsmodDecls . unLoc . pm_parsed_source)) - . runAction "changeSignature.GetParsedModule" state + . runAction (changeTypeSignatureId <> ".GetParsedModule") state . use GetParsedModule -- | Text representing a Declaration's Name @@ -146,7 +150,7 @@ stripSignature (T.filter (/= '\n') -> sig) = if T.isInfixOf " => " sig changeSigToCodeAction :: Uri -> ChangeSignature -> Command |? CodeAction changeSigToCodeAction uri ChangeSignature{..} = InR CodeAction { _title = mkChangeSigTitle declName actualType - , _kind = Just (CodeActionUnknown "quickfix.changeSignature") + , _kind = Just (CodeActionUnknown ("quickfix." <> changeTypeSignatureId)) , _diagnostics = Just $ List [diagnostic] , _isPreferred = Nothing , _disabled = Nothing From 6a5a3bc66e478396a875c547ac24c4cbc2d9c5fb Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 12:22:50 -0400 Subject: [PATCH 04/10] Update reference to ChangeTypeSignature descriptor --- exe/Plugins.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/exe/Plugins.hs b/exe/Plugins.hs index 8efe0b28a7..b41e53b5c9 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -189,7 +189,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins SelectionRange.descriptor "selectionRange" : #endif #if changeTypeSignature - ChangeTypeSignature.descriptor "changeTypeSignature" : + ChangeTypeSignature.descriptor : #endif -- The ghcide descriptors should come last so that the notification handlers -- (which restart the Shake build) run after everything else From a366ff5f3489dacd1b6eb778210e05b52928513a Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 18:12:20 -0400 Subject: [PATCH 05/10] Use unpack rather than show --- hls-plugin-api/src/Ide/PluginUtils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 3109d6a7c9..f3eb657bdd 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -257,9 +257,9 @@ getNormalizedFilePath (PluginId plId) docId = handleMaybe errMsg -- --------------------------------------------------------------------- throwPluginError :: Monad m => PluginId -> String -> String -> ExceptT String m b -throwPluginError who what where' = throwE msg +throwPluginError (PluginId who) what where' = throwE msg where - msg = show who <> " failed with "<> what <> " at " <> where' + msg = (T.unpack who) <> " failed with " <> what <> " at " <> where' handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b handleMaybe msg = maybe (throwE msg) return From 0d5cfcd3da25679284d9924e21c294e2487255bf Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Mon, 23 May 2022 18:16:56 -0400 Subject: [PATCH 06/10] Import cleanup --- .../src/Ide/Plugin/AlternateNumberFormat.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 889b8add30..954b39fcf9 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -5,7 +5,6 @@ {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where -import Control.Lens ((^.)) import Control.Monad.Except (ExceptT, MonadIO, liftIO) import qualified Data.HashMap.Strict as HashMap import Data.String (IsString) @@ -32,12 +31,9 @@ import Ide.Plugin.Conversion (AlternateFormat, alternateFormat) import Ide.Plugin.Literals import Ide.PluginUtils (getNormalizedFilePath, - handleMaybe, handleMaybeM, - pluginResponse, - throwPluginError) + handleMaybeM, pluginResponse) import Ide.Types import Language.LSP.Types -import Language.LSP.Types.Lens (uri) newtype Log = LogShake Shake.Log deriving Show From e4479360da64a64382151226345641e0c2633c3e Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Tue, 24 May 2022 09:18:52 -0400 Subject: [PATCH 07/10] Merge cleanup --- hls-plugin-api/src/Ide/PluginUtils.hs | 2 -- .../src/Ide/Plugin/AlternateNumberFormat.hs | 6 ++++-- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index b963741be7..19303516ac 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -36,7 +36,6 @@ module Ide.PluginUtils where -import Control.Lens ((^.)) import Control.Monad.Extra (maybeM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) @@ -57,7 +56,6 @@ import Language.LSP.Types hiding SemanticTokensEdit (_start)) import qualified Language.LSP.Types as J import Language.LSP.Types.Capabilities -import Language.LSP.Types.Lens (uri) -- --------------------------------------------------------------------- diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 1412b99c25..2ff61f1267 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where +import Control.Lens ((^.)) import Control.Monad.Except (ExceptT, MonadIO, liftIO) import qualified Data.HashMap.Strict as HashMap import Data.String (IsString) @@ -34,6 +35,7 @@ import Ide.PluginUtils (getNormalizedFilePath, handleMaybeM, pluginResponse) import Ide.Types import Language.LSP.Types +import qualified Language.LSP.Types.Lens as L newtype Log = LogShake Shake.Log deriving Show @@ -85,8 +87,8 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do - nfp <- getNormalizedFilePath plId (docId ^. uri) +codeActionHandler state plId (CodeActionParams _ _ docId currRange _) = pluginResponse $ do + nfp <- getNormalizedFilePath plId (docId ^. L.uri) CLR{..} <- requestLiterals state nfp pragma <- getFirstPragma state nfp -- remove any invalid literals (see validTarget comment) diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index 17770ff18f..0a4b1de41e 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -50,7 +50,7 @@ callHierarchyId = PluginId "callHierarchy" -- | Render prepare call hierarchy request. prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHierarchy prepareCallHierarchy state pluginId param = pluginResponse $ do - nfp <- getNormalizedFilePath pluginId (param ^. L.textDocument) + nfp <- getNormalizedFilePath pluginId (param ^. L.textDocument ^. L.uri) items <- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp (param ^. L.position))) pure (List <$> items) From a47101735d0442267fa17de6d94a7c7870e7ca49 Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Tue, 24 May 2022 22:40:18 -0400 Subject: [PATCH 08/10] Fix test suites for effected plugins --- .../src/Ide/Plugin/AlternateNumberFormat.hs | 2 +- plugins/hls-alternate-number-format-plugin/test/Main.hs | 2 +- plugins/hls-call-hierarchy-plugin/test/Main.hs | 2 +- plugins/hls-change-type-signature-plugin/test/Main.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 2ff61f1267..e240ee297d 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -152,7 +152,7 @@ getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ (_, fileContents) <- liftIO $ runAction (alternateNumberFormatId <> ".GetFileContents") state $ getFileContents nfp case ghcSession of Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents - Nothing -> pure Nothing + Nothing -> pure Nothing requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult requestLiterals state = handleMaybeM "Error: Could not Collect Literals" diff --git a/plugins/hls-alternate-number-format-plugin/test/Main.hs b/plugins/hls-alternate-number-format-plugin/test/Main.hs index 1da9d4d10c..a5fcc73f73 100644 --- a/plugins/hls-alternate-number-format-plugin/test/Main.hs +++ b/plugins/hls-alternate-number-format-plugin/test/Main.hs @@ -21,7 +21,7 @@ main :: IO () main = defaultTestRunner test alternateNumberFormatPlugin :: PluginDescriptor IdeState -alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty "alternateNumberFormat" +alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty -- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time. -- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index dc2a6cec5a..1b2cb0480d 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -21,7 +21,7 @@ import qualified System.IO.Extra import Test.Hls plugin :: PluginDescriptor IdeState -plugin = descriptor "callHierarchy" +plugin = descriptor main :: IO () main = defaultTestRunner $ diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index e04a0d4944..a5b58cf02d 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -32,7 +32,7 @@ main :: IO () main = defaultTestRunner test changeTypeSignaturePlugin :: PluginDescriptor IdeState -changeTypeSignaturePlugin = ChangeTypeSignature.descriptor "changeTypeSignature" +changeTypeSignaturePlugin = ChangeTypeSignature.descriptor test :: TestTree test = testGroup "changeTypeSignature" [ From e5c450c918c13354209d51b53fe75c3e54447118 Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Thu, 26 May 2022 13:16:21 -0400 Subject: [PATCH 09/10] forgot to change the CodeAction kind in the test suite... --- docs/features.md | 7 +++++++ ghcide/src/Development/IDE/Spans/AtPoint.hs | 15 +++++++++------ ghcide/src/Development/IDE/Spans/Common.hs | 7 +++++-- ghcide/test/exe/Main.hs | 6 ++++-- .../hls-change-type-signature-plugin/test/Main.hs | 4 ++-- 5 files changed, 27 insertions(+), 12 deletions(-) diff --git a/docs/features.md b/docs/features.md index 74a686b8cd..acc3d85fa6 100644 --- a/docs/features.md +++ b/docs/features.md @@ -274,6 +274,13 @@ Evaluates code blocks in comments with a click. [Tutorial](https://github.com/ha ![Eval Demo](https://raw.githubusercontent.com/haskell/haskell-language-server/master/plugins/hls-eval-plugin/demo.gif) +Known limitations: + +- Standard input is shared with HLS, so e.g. [`getLine` breaks the connection to server](https://github.com/haskell/haskell-language-server/issues/2913). +- Standard (error) output [is not captured](https://github.com/haskell/haskell-language-server/issues/1977). +- While similar to [doctest](https://hackage.haskell.org/package/doctest), some of its features are unsupported, + see [Differences with doctest](https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-eval-plugin/README.md#differences-with-doctest). + ### Make import lists fully explicit code lens Provided by: `hls-explicit-imports-plugin` diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 0ad8b86e9c..c729ec8e5d 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -32,9 +32,9 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Spans.Common import Development.IDE.Types.Options -import Development.IDE.GHC.Util (printOutputable) import Control.Applicative import Control.Monad.Extra @@ -231,11 +231,14 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p prettyNames = map prettyName names prettyName (Right n, dets) = T.unlines $ wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) - : definedAt n - ++ maybeToList (prettyPackageName n) + : maybeToList (pretty (definedAt n) (prettyPackageName n)) ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n ] where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n + pretty Nothing Nothing = Nothing + pretty (Just define) Nothing = Just $ define <> "\n" + pretty Nothing (Just pkgName) = Just $ pkgName <> "\n" + pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n" prettyName (Left m,_) = printOutputable m prettyPackageName n = do @@ -244,7 +247,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p conf <- lookupUnit env pid let pkgName = T.pack $ unitPackageNameString conf version = T.pack $ showVersion (unitPackageVersion conf) - pure $ " *(" <> pkgName <> "-" <> version <> ")*" + pure $ "*(" <> pkgName <> "-" <> version <> ")*" prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of @@ -255,8 +258,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p -- do not show "at " and similar messages -- see the code of 'pprNameDefnLoc' for more information case nameSrcLoc name of - UnhelpfulLoc {} | isInternalName name || isSystemName name -> [] - _ -> ["*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"] + UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing + _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*" typeLocationsAtPoint :: forall m diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 7da8c70cd9..dd241e7fc9 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -51,9 +51,7 @@ safeTyThingId _ = Nothing -- Possible documentation for an element in the code data SpanDoc = SpanDocString HsDocString SpanDocUris - -- ^ Extern module doc | SpanDocText [T.Text] SpanDocUris - -- ^ Local module doc deriving stock (Eq, Show, Generic) deriving anyclass NFData @@ -80,6 +78,11 @@ emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing) -- it will result "xxxx---\nyyyy" and can't be rendered as a normal doc. -- Therefore we check every item in the value to make sure they all end with '\\n', -- this makes "xxxx\n---\nyyy\n" and can be rendered correctly. +-- +-- Notes: +-- +-- To insert a new line in Markdown, we need two '\\n', like ("\\n\\n"), __or__ a section +-- symbol with one '\\n', like ("***\\n"). spanDocToMarkdown :: SpanDoc -> [T.Text] spanDocToMarkdown = \case (SpanDocString docs uris) -> diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index d66fc30ca8..f13c4e183c 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4254,6 +4254,7 @@ findDefinitionAndHoverTests = let ExpectRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets + ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool) ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover _ -> pure () -- all other expectations not relevant to hover _ -> liftIO $ assertFailure $ "test not expecting this kind of hover info" <> show hover @@ -4344,7 +4345,7 @@ findDefinitionAndHoverTests = let innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7] holeL60 = Position 62 7 ; hleInfo = [ExpectHoverText ["_ ::"]] holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] - cccL17 = Position 17 16 ; docLink = [ExpectHoverText ["[Documentation](file:///"]] + cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]] @@ -4399,7 +4400,7 @@ findDefinitionAndHoverTests = let , test broken broken innL48 innSig "inner signature #767" , test no yes holeL60 hleInfo "hole without internal name #831" , test no yes holeL65 hleInfo2 "hole with variable" - , test no skip cccL17 docLink "Haddock html links" + , test no yes cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" , if | ghcVersion == GHC90 && isWindows -> @@ -5743,6 +5744,7 @@ data Expect -- | ExpectDefRange Range -- Only gotoDef should report this range | ExpectHoverRange Range -- Only hover should report this range | ExpectHoverText [T.Text] -- the hover message must contain these snippets + | ExpectHoverTextRegex T.Text -- the hover message must match this pattern | ExpectExternFail -- definition lookup in other file expected to fail | ExpectNoDefinitions | ExpectNoHover diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index a5b58cf02d..ba5d917754 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -112,8 +112,8 @@ findChangeTypeActions = pure . filter isChangeTypeAction . rights . map toEither isChangeTypeAction CodeAction{_kind} = case _kind of Nothing -> False Just kind -> case kind of - "quickfix.changeSignature" -> True - _ -> False + "quickfix.changeTypeSignature" -> True + _ -> False regexTest :: FilePath -> Text -> Bool -> TestTree From 594f3ea4e513eb8f26bc90a22f34aa5a39012ab3 Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Thu, 26 May 2022 20:16:22 -0400 Subject: [PATCH 10/10] Update new plugin --- plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs index 478ed94e8b..f1c7d993d9 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -52,7 +52,7 @@ toGADTSyntaxCommandId = "GADT.toGADT" -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams -toGADTCommand plId state ToGADTParams{..} = response $ do +toGADTCommand plId state ToGADTParams{..} = pluginResponse $ do nfp <- getNormalizedFilePath plId uri (decls, exts) <- getInRangeH98DeclsAndExts state range nfp (L ann decl) <- case decls of @@ -82,7 +82,7 @@ toGADTCommand plId state ToGADTParams{..} = response $ do Nothing Nothing codeActionHandler :: PluginMethodHandler IdeState TextDocumentCodeAction -codeActionHandler state plId (CodeActionParams _ _ doc range _) = response $ do +codeActionHandler state plId (CodeActionParams _ _ doc range _) = pluginResponse $ do nfp <- getNormalizedFilePath plId (doc ^. L.uri) (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nfp let actions = map (mkAction . printOutputable . tcdLName . unLoc) inRangeH98Decls