diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 09f20a8aee..54f761474a 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -251,11 +251,6 @@ jobs: name: Test hls-cabal-plugin test suite run: cabal test ${CABAL_ARGS} hls-cabal-plugin-tests || cabal test ${CABAL_ARGS} hls-cabal-plugin-tests - # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' && matrix.ghc != '9.14' && matrix.ghc != '9.10.2' - name: Test hls-retrie-plugin test suite - run: cabal test ${CABAL_ARGS} hls-retrie-plugin-tests || cabal test ${CABAL_ARGS} hls-retrie-plugin-tests - - if: matrix.test name: Test hls-overloaded-record-dot-plugin test suite run: cabal test ${CABAL_ARGS} hls-overloaded-record-dot-plugin-tests || cabal test ${CABAL_ARGS} hls-overloaded-record-dot-plugin-tests diff --git a/CODEOWNERS b/CODEOWNERS index 8d54022dc5..c734317bea 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -35,7 +35,6 @@ /plugins/hls-qualify-imported-names-plugin @eddiemundo /plugins/hls-refactor-plugin @santiweight /plugins/hls-rename-plugin -/plugins/hls-retrie-plugin @wz1000 /plugins/hls-semantic-tokens-plugin @soulomoon /plugins/hls-signature-help-plugin @jian-lin /plugins/hls-splice-plugin @konn diff --git a/bench/config.yaml b/bench/config.yaml index 18211f4f24..3844c1326e 100644 --- a/bench/config.yaml +++ b/bench/config.yaml @@ -223,7 +223,6 @@ configurations: # - pragmas # - qualifyImportedNames # - rename -# - retrie # - splice # - stan # # - stylish-haskell diff --git a/docs/configuration.md b/docs/configuration.md index 1a4eb28f44..28f1a7d621 100644 --- a/docs/configuration.md +++ b/docs/configuration.md @@ -52,7 +52,7 @@ Here is a list of the additional settings currently supported by `haskell-langua Plugins have a generic config to control their behaviour. The schema of such config is: - `haskell.plugin.${pluginName}.globalOn`: usually with default true. Whether the plugin is enabled at runtime or it is not. That is the option you might use if you want to disable completely a plugin. - - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `importLens`, `class`, `hlint`, `retrie`, `rename`, `splice`, `stan`, `signatureHelp`. + - Actual plugin names are: `ghcide-code-actions-fill-holes`, `ghcide-completions`, `ghcide-hover-and-symbols`, `ghcide-type-lenses`, `ghcide-code-actions-type-signatures`, `ghcide-code-actions-bindings`, `ghcide-code-actions-imports-exports`, `eval`, `moduleName`, `pragmas`, `importLens`, `class`, `hlint`, `rename`, `splice`, `stan`, `signatureHelp`. - So to disable the import lens with an explicit list of module definitions you could set `haskell.plugin.importLens.globalOn: false` - `haskell.plugin.${pluginName}.${lspCapability}On`: usually with default true. Whether a concrete plugin capability is enabled. - Capabilities are the different ways a lsp server can interact with the editor. The current available capabilities of the server are: `callHierarchy`, `codeActions`, `codeLens`, `diagnostics`, `hover`, `symbols`, `completion`, `rename`. diff --git a/docs/contributing/plugin-tutorial.md b/docs/contributing/plugin-tutorial.md index d9ca59c0ad..627f6625f2 100644 --- a/docs/contributing/plugin-tutorial.md +++ b/docs/contributing/plugin-tutorial.md @@ -16,8 +16,6 @@ In the last couple of months, I have written various HLS plugins, including: 1. Suggest imports for variables not in scope, 2. Remove redundant imports, 3. Evaluate code in comments (à la [doctest](https://docs.python.org/3/library/doctest.html)), -4. Integrate the [retrie](https://github.com/facebookincubator/retrie) refactoring library. - These plugins are small but meaningful steps towards a more polished IDE experience. While writing them, I didn't have to worry about performance, UI, or distribution; another tool (usually GHC) always did the heavy lifting. @@ -77,7 +75,6 @@ The HLS codebase includes several plugins (found in `./plugins`). For example: - The `ormolu`, `fourmolu`, `floskell` and `stylish-haskell` plugins used to format code - The `eval` plugin, a code lens provider to evaluate code in comments -- The `retrie` plugin, a code action provider to execute retrie commands I recommend looking at the existing plugins for inspiration and reference. A few conventions shared by all plugins are: @@ -99,7 +96,6 @@ I recommend looking at the existing plugins for inspiration and reference. A few , Fourmolu.descriptor "fourmolu" , Ormolu.descriptor "ormolu" , StylishHaskell.descriptor "stylish-haskell" - , Retrie.descriptor "retrie" , Eval.descriptor "eval" , NewPlugin.descriptor "new-plugin" -- Add new plugins here. ] diff --git a/docs/features.md b/docs/features.md index 2f34f501cc..2036a84df5 100644 --- a/docs/features.md +++ b/docs/features.md @@ -238,24 +238,6 @@ Code action kind: `quickfix` Adds placeholders for missing class methods in a class instance definition. -### Unfold definition - -Provided by: `hls-retrie-plugin` - -Code action kind: `refactor.extract` - -Extracts a definition from the code. - -### Fold definition - -Provided by: `hls-retrie-plugin` - -Code action kind: `refactor.inline` - -Inlines a definition from the code. - -![Retrie Demo](https://i.imgur.com/Ev7B87k.gif) - ### Insert contents of Template Haskell splice Provided by: `hls-splice-plugin` diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index d93aa3db5a..478467f688 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -67,7 +67,6 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-semantic-tokens-plugin` | 2 | | | `hls-floskell-plugin` | 3 | 9.10.1, 9.12.2, 9.14.1 | | `hls-stan-plugin` | 3 | 9.12.2, 9.14.1 | -| `hls-retrie-plugin` | 3 | 9.10.1, 9.12.2, 9.14.1 | | `hls-splice-plugin` | 3 | 9.10.1, 9.12.2, 9.14.1 | [1]: HLint is incompatible with GHC 9.10 series. See the issue [#4674](https://github.com/haskell/haskell-language-server/issues/4674) for discussion and explanation. diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c448b1abee..843e5c83f5 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -631,66 +631,6 @@ test-suite hls-rename-plugin-tests , lsp-types , text ------------------------------ --- retrie plugin ------------------------------ - -flag retrie - description: Enable retrie plugin - default: True - manual: True - -common retrie - if flag(retrie) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)) - build-depends: haskell-language-server:hls-retrie-plugin - cpp-options: -Dhls_retrie - -library hls-retrie-plugin - import: defaults, pedantic, warnings - if !(flag(retrie) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))) - buildable: False - exposed-modules: Ide.Plugin.Retrie - hs-source-dirs: plugins/hls-retrie-plugin/src - build-depends: - , aeson - , bytestring - , containers - , extra - , ghc - , ghcide == 2.13.0.0 - , hashable - , hls-plugin-api == 2.13.0.0 - , haskell-language-server:hls-refactor-plugin - , lens - , lsp - , lsp-types - , mtl - , retrie >=0.1.1.0 - , safe-exceptions - , stm - , text - , text-rope - , transformers - , unordered-containers - - default-extensions: - DataKinds - -test-suite hls-retrie-plugin-tests - import: defaults, pedantic, test-defaults, warnings - if !(flag(retrie) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))) - buildable: False - type: exitcode-stdio-1.0 - hs-source-dirs: plugins/hls-retrie-plugin/test - main-is: Main.hs - build-depends: - , containers - , filepath - , hls-plugin-api - , haskell-language-server:{hls-refactor-plugin, hls-retrie-plugin} - , hls-test-utils == 2.13.0.0 - , text - ----------------------------- -- hlint plugin ----------------------------- @@ -1927,7 +1867,6 @@ library , eval , importLens , rename - , retrie , hlint , stan , signatureHelp diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs deleted file mode 100644 index 2e39ffcd98..0000000000 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ /dev/null @@ -1,789 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} - -{-# OPTIONS -Wno-orphans #-} - -module Ide.Plugin.Retrie (descriptor, Log) where - -import Control.Concurrent.STM (readTVarIO) -import Control.Exception.Safe (Exception (..), - SomeException, assert, - catch, throwIO, try) -import Control.Lens.Operators -import Control.Monad (forM, unless, when) -import Control.Monad.Error.Class (MonadError (throwError)) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (MonadTrans (lift)) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) - -import Control.Monad.Trans.Maybe (MaybeT) -import Data.Aeson (FromJSON (..), - ToJSON (..)) -import Data.Bifunctor (second) -import qualified Data.ByteString as BS -import Data.Data -import Data.Either (partitionEithers) -import Data.Hashable (unhashed) -import qualified Data.HashSet as Set -import Data.IORef.Extra (atomicModifyIORef'_, - newIORef, readIORef) -import Data.List.Extra (find, nubOrdOn) -import qualified Data.Map as Map -import Data.Maybe (catMaybes) -import Data.Monoid (First (First)) -import Data.String (IsString) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE hiding (pluginHandlers) -import Development.IDE.Core.Actions (lookupMod) -import Development.IDE.Core.PluginUtils -import Development.IDE.Core.PositionMapping -import Development.IDE.Core.Shake (ShakeExtras (ShakeExtras, knownTargetsVar), - getShakeExtras, - hiedbWriter, - toKnownFiles, withHieDb) -import Development.IDE.GHC.Compat (GRHSs (GRHSs), - GenLocated (L), GhcPs, - GhcRn, - HsBindLR (FunBind), - HsExpr (HsApp, OpApp), - HsGroup (..), - HsValBindsLR (..), - HscEnv, ImportDecl (..), - LHsExpr, LRuleDecls, - Match, ModIface, - ModSummary (ModSummary, ms_hspp_buf, ms_mod), - Outputable, ParsedModule, - RuleDecl (HsRule), - RuleDecls (HsRules), - SourceText (..), - TyClDecl (SynDecl), - TyClGroup (..), fun_id, - isQual, isQual_maybe, - locA, mi_fixities, - moduleNameString, - ms_hspp_opts, - nameModule_maybe, - nameOccName, nameRdrName, - noLocA, occNameFS, - occNameString, - pattern IsBoot, - pattern NotBoot, - pattern RealSrcSpan, - pm_parsed_source, - rdrNameOcc, rds_rules, - srcSpanFile, topDir, - unLoc, unLocA) -import qualified Development.IDE.GHC.Compat as GHC -import Development.IDE.GHC.Compat.Util hiding (catch, try) -import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource), - TransformT) -import Development.IDE.Spans.AtPoint (LookupModule, - nameToLocation) -import Development.IDE.Types.Shake (WithHieDb) -import qualified GHC as GHCGHC -import GHC.Generics (Generic) -import Ide.Plugin.Error (PluginError (PluginInternalError), - getNormalizedFilePathE) -import Ide.PluginUtils -import Ide.Types -import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message as LSP -import Language.LSP.Protocol.Types as LSP -import Language.LSP.Server (ProgressCancellable (Cancellable)) -import Retrie (Annotated (astA), - AnnotatedModule, - Fixity (Fixity), - FixityDirection (InfixL), - Options, Options_ (..), - Verbosity (Loud), - addImports, apply, - applyWithUpdate) -import Retrie.Context -import Retrie.CPP (CPP (NoCPP), parseCPP) -import Retrie.ExactPrint (fix, makeDeltaAst, - transformA, unsafeMkA) -import Retrie.Expr (mkLocatedHsVar) -import Retrie.Fixity (FixityEnv, lookupOp, - mkFixityEnv) -import Retrie.Monad (getGroundTerms, - runRetrie) -import Retrie.Options (defaultOptions, - getTargetFiles) -import Retrie.Replace (Change (..), - Replacement (..)) -import Retrie.Rewrites -import Retrie.Rewrites.Function (matchToRewrites) -import Retrie.SYB (everything, extQ, - listify, mkQ) -import Retrie.Types -import Retrie.Universe (Universe) - -import GHC.Types.PkgQual - -data Log - = LogParsingModule FilePath - -instance Pretty Log where - pretty = \case - LogParsingModule fp -> "Parsing module:" <+> pretty fp - -descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = - (defaultPluginDescriptor plId "Provides code actions to inline Haskell definitions") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction provider, - pluginCommands = [retrieCommand recorder, retrieInlineThisCommand recorder] - } - -retrieCommandId :: CommandId -retrieCommandId = "retrieCommand" - -retrieInlineThisCommandId :: CommandId -retrieInlineThisCommandId = "retrieInlineThisCommand" - -retrieCommand :: Recorder (WithPriority Log) -> PluginCommand IdeState -retrieCommand recorder = - PluginCommand retrieCommandId "run the refactoring" (runRetrieCmd recorder) - -retrieInlineThisCommand :: Recorder (WithPriority Log) -> PluginCommand IdeState -retrieInlineThisCommand recorder = - PluginCommand retrieInlineThisCommandId "inline function call" - (runRetrieInlineThisCmd recorder) - --- | Parameters for the runRetrie PluginCommand. -data RunRetrieParams = RunRetrieParams - { description :: T.Text, - rewrites :: [RewriteSpec], - originatingFile :: Uri, - restrictToOriginatingFile :: Bool - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -runRetrieCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState RunRetrieParams -runRetrieCmd recorder state token RunRetrieParams{originatingFile = uri, ..} = ExceptT $ - pluginWithIndefiniteProgress description token Cancellable $ \_updater -> do - _ <- runExceptT $ do - nfp <- getNormalizedFilePathE uri - (session, _) <- - runActionE "Retrie.GhcSessionDeps" state $ - useWithStaleE GhcSessionDeps - nfp - (ms, binds, _, _, _) <- runActionE "Retrie.getBinds" state $ getBinds nfp - let importRewrites = concatMap (extractImports ms binds) rewrites - (errors, edits) <- liftIO $ - callRetrie - recorder - state - (hscEnv session) - (map Right rewrites <> map Left importRewrites) - nfp - restrictToOriginatingFile - unless (null errors) $ - lift $ pluginSendNotification SMethod_WindowShowMessage $ - ShowMessageParams MessageType_Warning $ - T.unlines $ - "## Found errors during rewrite:" : - ["-" <> T.pack (show e) | e <- errors] - _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edits) (\_ -> pure ()) - return () - return $ Right $ InR Null - -data RunRetrieInlineThisParams = RunRetrieInlineThisParams - { inlineIntoThisLocation :: !Location, - inlineFromThisLocation :: !Location, - inlineThisDefinition :: !T.Text - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -runRetrieInlineThisCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState RunRetrieInlineThisParams -runRetrieInlineThisCmd recorder state _token RunRetrieInlineThisParams{..} = do - nfp <- getNormalizedFilePathE $ getLocationUri inlineIntoThisLocation - nfpSource <- getNormalizedFilePathE $ getLocationUri inlineFromThisLocation - -- What we do here: - -- Find the identifier in the given position - -- Construct an inline rewrite for it - -- Run retrie to get a list of changes - -- Select the change that inlines the identifier in the given position - -- Apply the edit - astSrc <- runActionE "retrie" state $ - useE GetAnnotatedParsedSource nfpSource - let fromRange = rangeToRealSrcSpan nfpSource $ getLocationRange inlineFromThisLocation - intoRange = rangeToRealSrcSpan nfp $ getLocationRange inlineIntoThisLocation - inlineRewrite <- liftIO $ constructInlineFromIdentifer (unsafeMkA astSrc 0) fromRange - when (null inlineRewrite) $ throwError $ PluginInternalError "Empty rewrite" - (session, _) <- runActionE "retrie" state $ - useWithStaleE GhcSessionDeps nfp - (fixityEnv, cpp) <- liftIO $ getCPPmodule recorder state (hscEnv session) $ fromNormalizedFilePath nfp - result <- liftIO $ try @_ @SomeException $ - runRetrie fixityEnv (applyWithUpdate myContextUpdater inlineRewrite) cpp - case result of - Left err -> throwError $ PluginInternalError $ "Retrie - crashed with: " <> T.pack (show err) - Right (_,_,NoChange) -> throwError $ PluginInternalError "Retrie - inline produced no changes" - Right (_,_,Change replacements imports) -> do - let edits = asEditMap $ asTextEdits $ Change ourReplacement imports - wedit = WorkspaceEdit (Just edits) Nothing Nothing - ourReplacement = [ r - | r@Replacement{..} <- replacements - , RealSrcSpan intoRange Nothing `GHC.isSubspanOf` replLocation] - _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit - (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) - return $ InR Null - --- Override to skip adding binders to the context, which prevents inlining --- nested defined functions -myContextUpdater :: ContextUpdater -myContextUpdater c i = - updateContext c i - `extQ` (return . updExp) - `extQ` (skipUpdate @(GRHSs GhcPs (LHsExpr GhcPs))) - `extQ` (skipUpdate @(Match GhcPs (LHsExpr GhcPs))) - where - skipUpdate :: forall a m . Monad m => a -> TransformT m Context - skipUpdate _ = pure c - - -- override to skip the HsLet case - updExp :: HsExpr GhcPs -> Context - updExp HsApp{} = - c { ctxtParentPrec = HasPrec $ Retrie.Fixity (SourceText "HsApp") (10 + i - firstChild) InfixL } - -- Reason for 10 + i: (i is index of child, 0 = left, 1 = right) - -- In left child, prec is 10, so HsApp child will NOT get paren'd - -- In right child, prec is 11, so every child gets paren'd (unless atomic) - updExp (OpApp _ _ op _) = c { ctxtParentPrec = HasPrec $ lookupOp op (ctxtFixityEnv c) } - updExp _ = c { ctxtParentPrec = NeverParen } - -- Deal with Trees-That-Grow adding extension points - -- as the first child everywhere. - firstChild :: Int - firstChild = 1 - -extractImports :: ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec] -extractImports ModSummary{ms_mod} topLevelBinds (Unfold thing) - | Just FunBind {fun_matches} - <- find (\case FunBind{fun_id = L _ n} -> T.unpack (printOutputable n) == thing ; _ -> False) topLevelBinds - , names <- listify p fun_matches - = - [ AddImport {..} - | let ideclSource = False, - name <- names, - let r = nameRdrName name, - let ideclQualifiedBool = isQual r, - let ideclAsString = moduleNameString . fst <$> isQual_maybe r, - let ideclThing = Just (IEVar $ occNameString $ rdrNameOcc r), - Just ideclNameString <- - [moduleNameString . GHC.moduleName <$> nameModule_maybe name] - ] - where - p name = nameModule_maybe name /= Just ms_mod --- TODO handle imports for all rewrites -extractImports _ _ _ = [] - -------------------------------------------------------------------------------- - -provider :: PluginMethodHandler IdeState Method_TextDocumentCodeAction -provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) = do - let (LSP.CodeActionContext _diags _monly _) = ca - nfp <- getNormalizedFilePathE uri - - (ModSummary{ms_mod}, topLevelBinds, posMapping, hs_ruleds, hs_tyclds) - <- runActionE "retrie" state $ - getBinds nfp - - extras@ShakeExtras{ withHieDb, hiedbWriter } <- liftIO $ runAction "" state getShakeExtras - - range <- fromCurrentRangeE posMapping range - let pos = range ^. L.start - let rewrites = - concatMap (suggestBindRewrites uri pos ms_mod) topLevelBinds - ++ concatMap (suggestRuleRewrites uri pos ms_mod) hs_ruleds - ++ [ r - | TyClGroup {group_tyclds} <- hs_tyclds, - L (locA -> l) g <- group_tyclds, - pos `isInsideSrcSpan` l, - r <- suggestTypeRewrites uri ms_mod g - ] - - retrieCommands <- lift $ - forM rewrites $ \(title, kind, params) -> liftIO $ do - let c = mkLspCommand plId retrieCommandId title (Just [toJSON params]) - return $ CodeAction title (Just kind) Nothing Nothing Nothing Nothing (Just c) Nothing - - inlineSuggestions <- liftIO $ runIdeAction "" extras $ - suggestBindInlines plId uri topLevelBinds range withHieDb (lookupMod hiedbWriter) - let inlineCommands = - [ Just $ - CodeAction _title (Just CodeActionKind_RefactorInline) Nothing Nothing Nothing Nothing (Just c) Nothing - | c@Command{..} <- inlineSuggestions - ] - return $ InL [InR c | c <- retrieCommands ++ catMaybes inlineCommands] - -getLocationUri :: Location -> Uri -getLocationUri Location{_uri} = _uri - -getLocationRange :: Location -> Range -getLocationRange Location{_range} = _range - -getBinds :: NormalizedFilePath -> ExceptT PluginError Action - ( ModSummary - , [HsBindLR GhcRn GhcRn] - , PositionMapping - , [LRuleDecls GhcRn] - , [TyClGroup GhcRn] - ) -getBinds nfp = do - (tm, posMapping) <- useWithStaleE TypeCheck nfp - -- we use the typechecked source instead of the parsed source - -- to be able to extract module names from the Ids, - -- so that we can include adding the required imports in the retrie command - let rn = tmrRenamed tm - case rn of -#if MIN_VERSION_ghc(9,9,0) - (HsGroup{hs_valds, hs_ruleds, hs_tyclds}, _, _, _, _) -> do -#else - (HsGroup{hs_valds, hs_ruleds, hs_tyclds}, _, _, _) -> do -#endif - topLevelBinds <- case hs_valds of - ValBinds{} -> throwError $ PluginInternalError "getBinds: ValBinds not supported" - XValBindsLR (GHC.NValBinds binds _sigs :: GHC.NHsValBindsLR GhcRn) -> - pure [ decl - | (_, bagBinds) <- binds - , L _ decl <- bagToList bagBinds - ] - return (tmrModSummary tm, topLevelBinds, posMapping, hs_ruleds, hs_tyclds) - -suggestBindRewrites :: - Uri -> - Position -> - GHC.Module -> - HsBindLR GhcRn GhcRn -> - [(T.Text, CodeActionKind, RunRetrieParams)] -suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L (locA -> l') rdrName} - | pos `isInsideSrcSpan` l' = - let pprNameText = printOutputable rdrName - pprName = T.unpack pprNameText - unfoldRewrite restrictToOriginatingFile = - let rewrites = [Unfold (qualify ms_mod pprName)] - description = "Unfold " <> pprNameText <> describeRestriction restrictToOriginatingFile - in (description, CodeActionKind_RefactorInline, RunRetrieParams {..}) - foldRewrite restrictToOriginatingFile = - let rewrites = [Fold (qualify ms_mod pprName)] - description = "Fold " <> pprNameText <> describeRestriction restrictToOriginatingFile - in (description, CodeActionKind_RefactorExtract, RunRetrieParams {..}) - in [unfoldRewrite False, unfoldRewrite True, foldRewrite False, foldRewrite True] -suggestBindRewrites _ _ _ _ = [] - - -- find all the identifiers in the AST for which have source definitions -suggestBindInlines :: - PluginId - -> Uri - -> [HsBindLR GhcRn GhcRn] - -> Range - -> WithHieDb - -> (FilePath -> GHCGHC.ModuleName -> GHCGHC.Unit -> Bool -> MaybeT IdeAction Uri) - -> IdeAction [Command] -suggestBindInlines plId _uri binds range hie lookupMod = do - identifiers <- definedIdentifiers - return $ map (\(name, siteLoc, srcLoc) -> - let - title = "Inline " <> printedName - printedName = printOutputable name - params = RunRetrieInlineThisParams - { inlineIntoThisLocation = siteLoc - , inlineFromThisLocation = srcLoc - , inlineThisDefinition= printedName - } - in mkLspCommand plId retrieInlineThisCommandId title (Just [toJSON params]) - ) - (Set.toList identifiers) - where - definedIdentifiers = - -- we search for candidates to inline in RHSs only, skipping LHSs - everything (<>) (pure mempty `mkQ` getGRHSIdentifierDetails hie lookupMod) binds - - getGRHSIdentifierDetails :: - WithHieDb - -> (FilePath -> GHCGHC.ModuleName -> GHCGHC.Unit -> Bool -> MaybeT IdeAction Uri) - -> GRHSs GhcRn (LHsExpr GhcRn) - -> IdeAction (Set.HashSet (GHC.OccName, Location, Location)) - getGRHSIdentifierDetails a b it@GRHSs{} = - -- we only select candidates for which we have source code - everything (<>) (pure mempty `mkQ` getDefinedIdentifierDetailsViaHieDb a b) it - - getDefinedIdentifierDetailsViaHieDb :: WithHieDb -> LookupModule IdeAction -> GHC.LIdP GhcRn -> IdeAction (Set.HashSet (GHC.OccName, Location, Location)) - getDefinedIdentifierDetailsViaHieDb withHieDb lookupModule lname | name <- unLoc lname = - case srcSpanToLocation (GHC.getLocA lname) of - Just siteLoc - | siteRange <- getLocationRange siteLoc - , range `isSubrangeOf` siteRange -> do - mbSrcLocation <- nameToLocation withHieDb lookupModule name - return $ maybe mempty (Set.fromList . map (nameOccName name, siteLoc,)) mbSrcLocation - _ -> pure mempty - - -describeRestriction :: IsString p => Bool -> p -describeRestriction restrictToOriginatingFile = - if restrictToOriginatingFile then " in current file" else "" - -suggestTypeRewrites :: - Uri -> - GHC.Module -> - TyClDecl GhcRn -> - [(T.Text, CodeActionKind, RunRetrieParams)] -suggestTypeRewrites originatingFile ms_mod SynDecl {tcdLName} = - let pprNameText = printOutputable (unLocA tcdLName) - pprName = T.unpack pprNameText - unfoldRewrite restrictToOriginatingFile = - let rewrites = [TypeForward (qualify ms_mod pprName)] - description = "Unfold " <> pprNameText <> describeRestriction restrictToOriginatingFile - in (description, CodeActionKind_RefactorInline, RunRetrieParams {..}) - foldRewrite restrictToOriginatingFile = - let rewrites = [TypeBackward (qualify ms_mod pprName)] - description = "Fold " <> pprNameText <> describeRestriction restrictToOriginatingFile - in (description, CodeActionKind_RefactorExtract, RunRetrieParams {..}) - in [unfoldRewrite False, unfoldRewrite True, foldRewrite False, foldRewrite True] -suggestTypeRewrites _ _ _ = [] - -suggestRuleRewrites :: - Uri -> - Position -> - GHC.Module -> - LRuleDecls GhcRn -> - [(T.Text, CodeActionKind, RunRetrieParams)] -suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) = - concat - [ [ forwardRewrite ruleName True - , forwardRewrite ruleName False - , backwardsRewrite ruleName True - , backwardsRewrite ruleName False - ] - | L (locA -> l) r <- rds_rules, - pos `isInsideSrcSpan` l, - let HsRule {rd_name = L _ rn} = r, - let ruleName = unpackFS rn - ] - where - forwardRewrite ruleName restrictToOriginatingFile = - let rewrites = [RuleForward (qualify ms_mod ruleName)] - description = "Apply rule " <> T.pack ruleName <> " forward" <> - describeRestriction restrictToOriginatingFile - - in ( description, - CodeActionKind_Refactor, - RunRetrieParams {..} - ) - backwardsRewrite ruleName restrictToOriginatingFile = - let rewrites = [RuleBackward (qualify ms_mod ruleName)] - description = "Apply rule " <> T.pack ruleName <> " backwards" <> - describeRestriction restrictToOriginatingFile - in ( description, - CodeActionKind_Refactor, - RunRetrieParams {..} - ) - -qualify :: Outputable mod => mod -> String -> String -qualify ms_mod x = T.unpack (printOutputable ms_mod) <> "." <> x - -------------------------------------------------------------------------------- --- Retrie driving code - -data CallRetrieError - = CallRetrieInternalError String NormalizedFilePath - | NoParse NormalizedFilePath - | GHCParseError NormalizedFilePath String - | NoTypeCheck NormalizedFilePath - deriving (Eq) - -instance Show CallRetrieError where - show (CallRetrieInternalError msg f) = msg <> " - " <> fromNormalizedFilePath f - show (NoParse f) = "Cannot parse: " <> fromNormalizedFilePath f - show (GHCParseError f m) = "Cannot parse " <> fromNormalizedFilePath f <> " : " <> m - show (NoTypeCheck f) = "File does not typecheck: " <> fromNormalizedFilePath f - -instance Exception CallRetrieError - -callRetrie :: - Recorder (WithPriority Log) -> - IdeState -> - HscEnv -> - [Either ImportSpec RewriteSpec] -> - NormalizedFilePath -> - Bool -> - IO ([CallRetrieError], WorkspaceEdit) -callRetrie recorder state session rewrites origin restrictToOriginatingFile = do - knownFiles <- toKnownFiles . unhashed <$> readTVarIO (knownTargetsVar $ shakeExtras state) - let - -- TODO cover all workspaceFolders - target = "." - - retrieOptions :: Retrie.Options - retrieOptions = (defaultOptions target) - {Retrie.verbosity = Loud - ,Retrie.targetFiles = map fromNormalizedFilePath $ - if restrictToOriginatingFile - then [origin] - else Set.toList knownFiles - } - - (theImports, theRewrites) = partitionEithers rewrites - - annotatedImports = - unsafeMkA (map (noLocA . toImportDecl) theImports) 0 - - (originFixities, originParsedModule) <- reuseParsedModule state origin - retrie <- - (\specs -> apply specs >> addImports annotatedImports) - <$> parseSpecs state origin originParsedModule originFixities theRewrites - - targets <- getTargetFiles retrieOptions (getGroundTerms retrie) - - results <- forM targets $ \t -> runExceptT $ do - (fixityEnv, cpp) <- ExceptT $ try $ getCPPmodule recorder state session t - -- TODO add the imports to the resulting edits - (_user, _ast, change@(Change _replacements _imports)) <- - lift $ runRetrie fixityEnv retrie cpp - return $ asTextEdits change - - let (errors :: [CallRetrieError], replacements) = partitionEithers results - editParams :: WorkspaceEdit - editParams = - WorkspaceEdit (Just $ asEditMap $ concat replacements) Nothing Nothing - - return (errors, editParams) - -useOrFail :: - IdeRule r v => - IdeState -> - String -> - (NormalizedFilePath -> CallRetrieError) -> - r -> - NormalizedFilePath -> - IO (RuleResult r) -useOrFail state lbl mkException rule f = - useRule lbl state rule f >>= maybe (liftIO $ throwIO $ mkException f) return - -fixityEnvFromModIface :: ModIface -> FixityEnv -fixityEnvFromModIface modIface = - mkFixityEnv - [ (fs, (fs, fixity)) - | (n, fixity) <- mi_fixities modIface, - let fs = occNameFS n - ] - -fixFixities :: Data ast => - IdeState - -> NormalizedFilePath - -> Annotated ast - -> IO (FixityEnv, Annotated ast) -fixFixities state f pm = do - HiFileResult {hirModIface} <- - useOrFail state "GetModIface" NoTypeCheck GetModIface f - let fixities = fixityEnvFromModIface hirModIface - res <- transformA pm (fix fixities) - return (fixities, res) - -fixAnns :: ParsedModule -> Annotated GHC.ParsedSource -fixAnns GHC.ParsedModule{pm_parsed_source} = unsafeMkA (makeDeltaAst pm_parsed_source) 0 - -parseSpecs - :: IdeState - -> NormalizedFilePath - -> AnnotatedModule - -> FixityEnv - -> [RewriteSpec] - -> IO [Rewrite Universe] -parseSpecs state origin originParsedModule originFixities specs = do - -- retrie needs the libdir for `parseRewriteSpecs` - libdir <- topDir . ms_hspp_opts . msrModSummary <$> useOrFail state "Retrie.GetModSummary" (CallRetrieInternalError "file not found") GetModSummary origin - parseRewriteSpecs - libdir - (\_f -> return $ NoCPP originParsedModule) - originFixities - specs - -constructfromFunMatches :: - Annotated [GHCGHC.LocatedA (ImportDecl GhcPs)] - -> GHCGHC.LocatedN GHCGHC.RdrName - -> GHCGHC.MatchGroup GhcPs (GHCGHC.LocatedA (HsExpr GhcPs)) - -> TransformT IO [Rewrite Universe] -constructfromFunMatches imps fun_id fun_matches = do - fe <- mkLocatedHsVar fun_id - rewrites <- concat <$> - forM (unLoc $ GHC.mg_alts fun_matches) (matchToRewrites fe imps LeftToRight) - let urewrites = toURewrite <$> rewrites - -- traceShowM $ map showQuery urewrites - assert (not $ null urewrites) $ - return urewrites - --- showQuery :: Rewrite Universe -> String --- showQuery = ppRewrite --- --- showQuery :: Rewrite (LHsExpr GhcPs) -> String --- showQuery q = unlines --- [ "template: " <> show (hash (printOutputable . showAstData NoBlankSrcSpan . astA . tTemplate . fst . qResult $ q)) --- , "quantifiers: " <> show (hash (T.pack (show(Ext.toList $ qQuantifiers q)))) --- , "matcher: " <> show (hash (printOutputable . showAstData NoBlankSrcSpan . astA . qPattern $ q)) --- ] --- --- s :: Data a => a -> String --- s = T.unpack . printOutputable . showAstData NoBlankSrcSpan --- NoBlankEpAnnotations - -constructInlineFromIdentifer :: Data a => Annotated (GenLocated l a) -> GHCGHC.RealSrcSpan -> IO [Rewrite Universe] -constructInlineFromIdentifer originParsedModule originSpan = do - -- traceM $ s $ astA originParsedModule - fmap astA $ transformA originParsedModule $ \(L _ m) -> do - let ast = everything (<>) (First Nothing `mkQ` matcher) m - matcher :: HsBindLR GhcPs GhcPs - -> First ( GHCGHC.LocatedN GHCGHC.RdrName - , GHCGHC.MatchGroup GhcPs (GHCGHC.LocatedA (HsExpr GhcPs)) - ) - matcher FunBind{fun_id, fun_matches} - -- trace (show (GHC.getLocA fun_id) <> ": " <> s fun_id) False = undefined - | RealSrcSpan sp _ <- GHC.getLocA fun_id - , sp == originSpan = - First $ Just (fun_id, fun_matches) - matcher _ = First Nothing - case ast of - First (Just (fun_id, fun_matches)) - -> - let imports = mempty in - constructfromFunMatches imports fun_id fun_matches - _ -> return $ error "could not find source code to inline" - -asEditMap :: [(Uri, TextEdit)] -> Map.Map Uri [TextEdit] -asEditMap = Map.fromListWith (++) . map (second pure) - -asTextEdits :: Change -> [(Uri, TextEdit)] -asTextEdits NoChange = [] -asTextEdits (Change reps _imports) = - [ (filePathToUri spanLoc, edit) - | Replacement {..} <- nubOrdOn (realSpan . replLocation) reps, - (RealSrcSpan rspan _) <- [replLocation], - let spanLoc = unpackFS $ srcSpanFile rspan, - let edit = TextEdit (realSrcSpanToRange rspan) (T.pack replReplacement) - ] - -------------------------------------------------------------------------------- --- Rule wrappers - -_useRuleBlocking, - _useRuleStale, - useRule :: - (IdeRule k v) => - String -> - IdeState -> - k -> - NormalizedFilePath -> - IO (Maybe (RuleResult k)) -_useRuleBlocking label state rule f = runAction label state (use rule f) -_useRuleStale label state rule f = - fmap fst - <$> runIdeAction label (shakeExtras state) (useWithStaleFast rule f) - --- | Chosen approach for calling ghcide Shake rules -useRule label = _useRuleStale ("Retrie." <> label) - -------------------------------------------------------------------------------- --- Serialization wrappers and instances - -deriving instance Eq RewriteSpec - -deriving instance Show RewriteSpec - -deriving instance Generic RewriteSpec - -deriving instance FromJSON RewriteSpec - -deriving instance ToJSON RewriteSpec - -newtype IE name - = IEVar name - deriving stock (Eq, Show, Generic) - deriving anyclass (FromJSON, ToJSON) - - -data ImportSpec = AddImport - { ideclNameString :: String, - ideclSource :: Bool, - ideclQualifiedBool :: Bool, - ideclAsString :: Maybe String, - ideclThing :: Maybe (IE String) - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -toImportDecl :: ImportSpec -> GHC.ImportDecl GHC.GhcPs -toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} - where - ideclSource' = if ideclSource then IsBoot else NotBoot - toMod = noLocA . GHC.mkModuleName - ideclName = toMod ideclNameString - ideclSafe = False - ideclImplicit = False - ideclSourceSrc = NoSourceText - ideclAs = toMod <$> ideclAsString - ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified - - ideclPkgQual = NoRawPkgQual - - ideclImportList = Nothing - ideclExt = GHCGHC.XImportDeclPass - { ideclAnn = -#if MIN_VERSION_ghc(9,9,0) - GHCGHC.noAnn -#else - GHCGHC.EpAnnNotUsed -#endif - , ideclSourceText = ideclSourceSrc - , ideclImplicit = ideclImplicit - } - -reuseParsedModule :: IdeState -> NormalizedFilePath -> IO (FixityEnv, Annotated GHCGHC.ParsedSource) -reuseParsedModule state f = do - pm <- useOrFail state "Retrie.GetParsedModule" NoParse GetParsedModule f - (fixities, pm') <- fixFixities state f (fixAnns pm) - return (fixities, pm') - -getCPPmodule :: Recorder (WithPriority Log) -> IdeState -> HscEnv -> FilePath -> IO (FixityEnv, CPP AnnotatedModule) -getCPPmodule recorder state session t = do - -- TODO: is it safe to drop this makeAbsolute? - let nt = toNormalizedFilePath' $ (toAbsolute $ rootDir state) t - let getParsedModule f contents = do - modSummary <- msrModSummary <$> - useOrFail state "Retrie.GetModSummary" (CallRetrieInternalError "file not found") GetModSummary nt - let ms' = - modSummary - { ms_hspp_buf = - Just (stringToStringBuffer contents) - } - logWith recorder Info $ LogParsingModule t - parsed <- evalGhcEnv session (GHCGHC.parseModule ms') - `catch` \e -> throwIO (GHCParseError nt (show @SomeException e)) - (fixities, parsed) <- fixFixities state f (fixAnns parsed) - return (fixities, parsed) - - contents <- do - mbContentsVFS <- - runAction "Retrie.GetFileContents" state $ getFileContents nt - case mbContentsVFS of - Just contents -> return $ Rope.toText contents - Nothing -> T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath nt) - if any (T.isPrefixOf "#if" . T.toLower) (T.lines contents) - then do - fixitiesRef <- newIORef mempty - let parseModule x = do - (fix, res) <- getParsedModule nt x - atomicModifyIORef'_ fixitiesRef (fix <>) - return res - res <- parseCPP parseModule contents - fixities <- readIORef fixitiesRef - return (fixities, res) - else do - (fixities, pm) <- reuseParsedModule state nt - return (fixities, NoCPP pm) diff --git a/plugins/hls-retrie-plugin/test/Main.hs b/plugins/hls-retrie-plugin/test/Main.hs deleted file mode 100644 index 96a25b0c4c..0000000000 --- a/plugins/hls-retrie-plugin/test/Main.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} - -module Main (main) where - -import Control.Monad (void) -import qualified Data.Map as M -import Data.Text (Text) -import qualified Development.IDE.GHC.ExactPrint as ExactPrint -import qualified Development.IDE.Plugin.CodeAction as Refactor -import Ide.Logger -import Ide.Plugin.Config -import qualified Ide.Plugin.Retrie as Retrie -import System.FilePath -import Test.Hls - -data LogWrap - = RetrieLog Retrie.Log - | ExactPrintLog ExactPrint.Log - -instance Pretty LogWrap where - pretty = \case - RetrieLog msg -> pretty msg - ExactPrintLog msg -> pretty msg - -main :: IO () -main = defaultTestRunner tests - -retriePlugin :: PluginTestDescriptor LogWrap -retriePlugin = mkPluginTestDescriptor (Retrie.descriptor . cmapWithPrio RetrieLog) "retrie" - -refactorPlugin :: PluginTestDescriptor LogWrap -refactorPlugin = mkPluginTestDescriptor (Refactor.iePluginDescriptor . cmapWithPrio ExactPrintLog) "refactor" - -tests :: TestTree -tests = testGroup "Retrie" - [ inlineThisTests - ] - -inlineThisTests :: TestTree -inlineThisTests = testGroup "Inline this" - [ - testGroup "provider" [ - testProvider "lhs" "Identity" 4 1 ["Unfold function", "Unfold function in current file", "Fold function", "Fold function in current file"], - testProvider "identifier" "Identity" 4 16 ["Inline identity"], - testProvider "imported identifier" "Imported" 4 12 ["Inline identity"], - testProvider "nested where" "NestedWhere" 4 16 ["Inline identity"], - testProvider "nested let" "NestedLet" 6 12 ["Inline identity"], - testProvider "class member" "Class" 5 16 [], - testProvider "operator" "Operator" 4 16 ["Inline */"] - ], - testGroup "command" [ - testCommand "top level function" "Identity" 4 16, - testCommand "top level function in another file" "Imported" 4 12, - testCommand "nested where function" "NestedWhere" 4 16, - testCommand "nested let function" "NestedLet" 6 12, - testCommand "operator" "Operator" 4 16 - ] - ] - -testProvider :: TestName -> FilePath -> UInt -> UInt -> [Text] -> TestTree -testProvider title file line row expected = testCase title $ runWithRetrie $ do - adoc <- openDoc (file <.> "hs") "haskell" - _ <- waitForTypecheck adoc - let position = Position line row - codeActions <- getCodeActions adoc $ Range position position - liftIO $ map codeActionTitle codeActions @?= map Just expected - -testCommand :: TestName -> FilePath -> UInt -> UInt -> TestTree -testCommand title file row col = goldenWithRetrie title file $ \adoc -> do - _ <- waitForTypecheck adoc - let p = Position row col - codeActions <- getCodeActions adoc $ Range p p - case codeActions of - [InR ca] -> do - executeCodeAction ca - void $ skipManyTill anyMessage $ getDocumentEdit adoc - cas -> liftIO . assertFailure $ "One code action expected, got " <> show (length cas) - -codeActionTitle :: (Command |? CodeAction) -> Maybe Text -codeActionTitle (InR CodeAction {_title}) = Just _title -codeActionTitle _ = Nothing - -goldenWithRetrie :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithRetrie title path act = - goldenWithHaskellDoc (def { plugins = M.singleton "retrie" def }) testPlugins title testDataDir path "expected" "hs" act - -runWithRetrie :: Session a -> IO a -runWithRetrie = runSessionWithServer def testPlugins testDataDir - -testPlugins :: PluginTestDescriptor LogWrap -testPlugins = - retriePlugin <> - refactorPlugin -- needed for the GetAnnotatedParsedSource rule - -testDataDir :: FilePath -testDataDir = "plugins" "hls-retrie-plugin" "test" "testdata" diff --git a/plugins/hls-retrie-plugin/test/testdata/Class.hs b/plugins/hls-retrie-plugin/test/testdata/Class.hs deleted file mode 100644 index 644a647b5e..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Class.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Class where - -class Identity x where - identity :: x -> x - identity x = x - -function x = identity x diff --git a/plugins/hls-retrie-plugin/test/testdata/Identity.expected.hs b/plugins/hls-retrie-plugin/test/testdata/Identity.expected.hs deleted file mode 100644 index 8fbd1b5cea..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Identity.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Identity where - -identity x = x - -function x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/Identity.hs b/plugins/hls-retrie-plugin/test/testdata/Identity.hs deleted file mode 100644 index 3e81c40efa..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Identity.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Identity where - -identity x = x - -function x = identity x diff --git a/plugins/hls-retrie-plugin/test/testdata/Imported.expected.hs b/plugins/hls-retrie-plugin/test/testdata/Imported.expected.hs deleted file mode 100644 index 7670647d4d..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Imported.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Imported where - -import Identity - -f x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/Imported.hs b/plugins/hls-retrie-plugin/test/testdata/Imported.hs deleted file mode 100644 index 3773e396fc..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Imported.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Imported where - -import Identity - -f x = identity x diff --git a/plugins/hls-retrie-plugin/test/testdata/Nested.expected.hs b/plugins/hls-retrie-plugin/test/testdata/Nested.expected.hs deleted file mode 100644 index 8df3fbd2de..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Nested.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Nested where - - - -function x = x - where - identity x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/NestedLet.expected.hs b/plugins/hls-retrie-plugin/test/testdata/NestedLet.expected.hs deleted file mode 100644 index 0cd81093e9..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/NestedLet.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module NestedLet where - - - -function x = - let identity x = x - in x diff --git a/plugins/hls-retrie-plugin/test/testdata/NestedLet.hs b/plugins/hls-retrie-plugin/test/testdata/NestedLet.hs deleted file mode 100644 index ce7db202bd..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/NestedLet.hs +++ /dev/null @@ -1,7 +0,0 @@ -module NestedLet where - - - -function x = - let identity x = x - in identity x diff --git a/plugins/hls-retrie-plugin/test/testdata/NestedNested.hs b/plugins/hls-retrie-plugin/test/testdata/NestedNested.hs deleted file mode 100644 index e2935c4464..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/NestedNested.hs +++ /dev/null @@ -1,10 +0,0 @@ - -module NestedNested where - - - -function x = meme x - where - meme x = identity x - identity x = x - diff --git a/plugins/hls-retrie-plugin/test/testdata/NestedWhere.expected.hs b/plugins/hls-retrie-plugin/test/testdata/NestedWhere.expected.hs deleted file mode 100644 index 948779a429..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/NestedWhere.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module NestedWhere where - - - -function x = x - where - identity x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/NestedWhere.hs b/plugins/hls-retrie-plugin/test/testdata/NestedWhere.hs deleted file mode 100644 index edde87bb26..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/NestedWhere.hs +++ /dev/null @@ -1,7 +0,0 @@ -module NestedWhere where - - - -function x = identity x - where - identity x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/Operator.expected.hs b/plugins/hls-retrie-plugin/test/testdata/Operator.expected.hs deleted file mode 100644 index 4e351e4864..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Operator.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Operator where - -x */ y = x - -function x = x diff --git a/plugins/hls-retrie-plugin/test/testdata/Operator.hs b/plugins/hls-retrie-plugin/test/testdata/Operator.hs deleted file mode 100644 index 6c6b63522a..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/Operator.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Operator where - -x */ y = x - -function x = x */ () diff --git a/plugins/hls-retrie-plugin/test/testdata/hie.yaml b/plugins/hls-retrie-plugin/test/testdata/hie.yaml deleted file mode 100644 index bf059478ed..0000000000 --- a/plugins/hls-retrie-plugin/test/testdata/hie.yaml +++ /dev/null @@ -1,11 +0,0 @@ -cradle: - direct: - arguments: - - Class.hs - - Identity.hs - - Imported.hs - - Nested.hs - - NestedLet.hs - - NestedNested.hs - - NestedWhere.hs - - Operator.hs diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 51fc196fdb..d52c935240 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -41,10 +41,6 @@ import qualified Ide.Plugin.ExplicitImports as ExplicitImports import qualified Ide.Plugin.Rename as Rename #endif -#if hls_retrie -import qualified Ide.Plugin.Retrie as Retrie -#endif - #if hls_hlint import qualified Ide.Plugin.Hlint as Hlint #endif @@ -188,9 +184,6 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins #if hls_rename let pId = "rename" in Rename.descriptor (pluginRecorder pId) pId: #endif -#if hls_retrie - let pId = "retrie" in Retrie.descriptor (pluginRecorder pId) pId : -#endif #if hls_callHierarchy CallHierarchy.descriptor "callHierarchy" : #endif diff --git a/stack-lts22.yaml b/stack-lts22.yaml index 8ab74893bb..43d5743c7d 100644 --- a/stack-lts22.yaml +++ b/stack-lts22.yaml @@ -27,7 +27,6 @@ extra-deps: - lsp-test-0.17.1.0 - lsp-types-2.3.0.0 - monad-dijkstra-0.1.1.4 # 5 - - retrie-1.2.3 - unordered-containers-0.2.21 # stan and friends @@ -55,8 +54,6 @@ flags: pedantic: true stylish-haskell: ghc-lib: true - retrie: - BuildExecutable: false # stan dependencies directory-ospath-streaming: os-string: false diff --git a/stack.yaml b/stack.yaml index 2197d61eb7..3eaec9c2c4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,7 +14,6 @@ allow-newer: true allow-newer-deps: - extensions - hw-fingertree - - retrie # stan dependencies - directory-ospath-streaming @@ -26,7 +25,6 @@ extra-deps: - hie-bios-0.17.0 - hw-fingertree-0.1.2.1 - monad-dijkstra-0.1.1.5 - - retrie-1.2.3 - unordered-containers-0.2.21 # stan dependencies not found in the stackage snapshot @@ -49,8 +47,6 @@ flags: pedantic: true stylish-haskell: ghc-lib: true - retrie: - BuildExecutable: false # stan dependencies directory-ospath-streaming: os-string: false diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index beefc415fd..de08fe7640 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -136,9 +136,6 @@ }, "globalOn": true }, - "retrie": { - "globalOn": true - }, "semanticTokens": { "config": { "classMethodToken": "method", diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index aac5c16c08..37be883740 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -315,12 +315,6 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, "haskell.plugin.semanticTokens.config.classMethodToken": { "default": "method", "description": "LSP semantic token type to use for typeclass methods", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index beefc415fd..de08fe7640 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -136,9 +136,6 @@ }, "globalOn": true }, - "retrie": { - "globalOn": true - }, "semanticTokens": { "config": { "classMethodToken": "method", diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index aac5c16c08..37be883740 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -315,12 +315,6 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, "haskell.plugin.semanticTokens.config.classMethodToken": { "default": "method", "description": "LSP semantic token type to use for typeclass methods",