Reintroduce hls-retrie-plugin

.github/workflows/test.yml

@@ -241,6 +241,10 @@ 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
 
+      - if: matrix.test && matrix.ghc != '9.10' && 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

CODEOWNERS

@@ -35,6 +35,7 @@
 /plugins/hls-qualify-imported-names-plugin @eddiemundo
 /plugins/hls-refactor-plugin
 /plugins/hls-rename-plugin
+/plugins/hls-retrie-plugin @simonhorlick
 /plugins/hls-semantic-tokens-plugin @soulomoon
 /plugins/hls-signature-help-plugin @jian-lin
 /plugins/hls-splice-plugin @konn

bench/config.yaml

@@ -227,6 +227,7 @@ configurations:
 # - pragmas
 # - qualifyImportedNames
 # - rename
+# - retrie
 # - splice
 # - stan
 # # - stylish-haskell

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`, `rename`, `semanticTokens`, `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`, `retrie`, `rename`, `semanticTokens`, `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`.

docs/contributing/plugin-tutorial.md

@@ -16,6 +16,7 @@ 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)),
+
 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.
 
@@ -75,6 +76,7 @@ The HLS codebase includes several plugins (found in `./plugins`). For example:
 
 - The `ormolu`, `fourmolu`, 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:
 
@@ -95,6 +97,7 @@ 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.
         ]

docs/features.md

@@ -246,6 +246,22 @@ Code action kind: `quickfix`
 
 Adds placeholders for missing class methods in a class instance definition.
 
+### Fold definition
+
+Provided by: `hls-retrie-plugin`
+
+Code action kind: `refactor.extract`
+
+Replaces any instance of a function's body with a call to that function.
+
+### Unfold definition
+
+Provided by: `hls-retrie-plugin`
+
+Code action kind: `refactor.inline`
+
+Replaces every usage of a function with it's body.
+
 ### Insert contents of Template Haskell splice
 
 Provided by: `hls-splice-plugin`

docs/support/plugin-support.md

@@ -68,5 +68,6 @@ For example, a plugin to provide a formatter which has itself been abandoned has
 | `hls-semantic-tokens-plugin`         | 2    |                          |
 | `hls-stan-plugin`                    | 3    | 9.12.2, 9.14.1           |
 | `hls-splice-plugin`                  | 3    |                          |
+| `hls-retrie-plugin`                  | 3    | 9.10.*                   |
 
 [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.

ghcide/ghcide.cabal

@@ -189,6 +189,7 @@ library
     Development.IDE.Spans.AtPoint
     Development.IDE.Spans.Common
     Development.IDE.Spans.Documentation
+    Development.IDE.Spans.Fixity
     Development.IDE.Spans.LocalBindings
     Development.IDE.Spans.Pragmas
     Development.IDE.Types.Diagnostics

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -281,6 +281,16 @@ instance Show DocAndTyThingMap where
 
 type instance RuleResult GetDocMap = DocAndTyThingMap
 
+newtype FixityMap = FixityMap (M.Map Name Fixity)
+
+instance NFData FixityMap where
+    rnf (FixityMap xs) = rnf xs
+
+instance Show FixityMap where
+    show = const "FixityMap"
+
+type instance RuleResult GetFixity = FixityMap
+
 -- | A GHC session that we reuse.
 type instance RuleResult GhcSession = HscEnvEq
 
@@ -501,6 +511,11 @@ data GetDocMap = GetDocMap
 instance Hashable GetDocMap
 instance NFData   GetDocMap
 
+data GetFixity = GetFixity
+    deriving (Eq, Show, Generic)
+instance Hashable GetFixity
+instance NFData   GetFixity
+
 data GetHieAst = GetHieAst
     deriving (Eq, Show, Generic)
 instance Hashable GetHieAst

ghcide/src/Development/IDE/Core/Rules.hs

@@ -136,6 +136,7 @@ import           Development.IDE.Import.DependencyInformation
 import           Development.IDE.Import.FindImports
 import qualified Development.IDE.Spans.AtPoint                as AtPoint
 import           Development.IDE.Spans.Documentation
+import           Development.IDE.Spans.Fixity
 import           Development.IDE.Spans.LocalBindings
 import           Development.IDE.Types.Diagnostics            as Diag
 import           Development.IDE.Types.HscEnvEq
@@ -199,6 +200,8 @@ import           System.FilePath                              (dropExtension,
                                                                splitDirectories,
                                                                takeExtension,
                                                                takeFileName)
+import qualified Data.Set                                     as S
+import           Data.Either                                  (isRight)
 
 data Log
   = LogShake Shake.Log
@@ -600,6 +603,20 @@ getDocMapRule recorder =
 persistentDocMapRule :: Rules ()
 persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty mempty, idDelta, Nothing)
 
+getFixityRule :: Recorder (WithPriority Log) -> Rules ()
+getFixityRule recorder =
+    define (cmapWithPrio LogShake recorder) $ \GetFixity nfp -> do
+        HAR{refMap} <- use_ GetHieAst nfp
+        env <- hscEnv <$> use_ GhcSessionDeps nfp -- deps necessary so that we can consult already loaded in ifaces instead of loading in duplicates
+        tcGblEnv <- tmrTypechecked <$> use_ TypeCheck nfp
+        fs <- lookupFixities env tcGblEnv (S.mapMonotonic (\(Right n) -> n) $ S.filter isRight $ M.keysSet refMap)
+        pure ([], Just (FixityMap fs))
+
+
+-- | Persistent rule to ensure that hover doesn't block on startup
+persistentFixityRule :: Rules ()
+persistentFixityRule = addPersistentRule GetFixity $ \_ -> pure $ Just (FixityMap M.empty, idDelta, Nothing)
+
 readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile
 readHieFileForSrcFromDisk recorder file = do
   ShakeExtras{withHieDb} <- ask
@@ -1441,6 +1458,7 @@ mainRule recorder RulesConfig{..} = do
     reportImportCyclesRule recorder
     typeCheckRule recorder
     getDocMapRule recorder
+    getFixityRule recorder
     loadGhcSession recorder def{fullModuleGraph}
     getModIfaceFromDiskRule recorder
     getModIfaceFromDiskAndIndexRule recorder
@@ -1467,6 +1485,7 @@ mainRule recorder RulesConfig{..} = do
     getImportMapRule recorder
     persistentHieFileRule recorder
     persistentDocMapRule
+    persistentFixityRule
     persistentImportMapRule
     getLinkableRule recorder
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do

ghcide/src/Development/IDE/GHC/Orphans.hs

@@ -49,6 +49,7 @@ instance Show ModDetails where show = const "<moddetails>"
 instance NFData ModDetails where rnf = rwhnf
 #if !MIN_VERSION_ghc(9,13,0)
 instance NFData SafeHaskellMode where rnf = rwhnf
+instance NFData Fixity where rnf = rwhnf
 #endif
 instance Show Linkable where show = unpack . printOutputable
 #if MIN_VERSION_ghc(9,11,0)

ghcide/src/Development/IDE/Spans/Fixity.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Development.IDE.Spans.Fixity (lookupFixities) where
+
+import           Control.Monad.IO.Class          (MonadIO, liftIO)
+import qualified Data.Map.Strict                 as M
+import           Data.Maybe                      (fromMaybe)
+import qualified Data.Set                        as S
+import           Development.IDE.GHC.Compat
+import qualified Development.IDE.GHC.Compat.Util as Util
+
+-- | Convert a HieAST to FixityTree with fixity info gathered
+lookupFixities :: MonadIO m => HscEnv -> TcGblEnv -> S.Set Name -> m (M.Map Name Fixity)
+lookupFixities hscEnv tcGblEnv names
+    = liftIO
+    $ fmap (fromMaybe M.empty . snd)
+    $ initTcWithGbl hscEnv tcGblEnv (realSrcLocSpan $ mkRealSrcLoc "<dummy>" 1 1)
+    $ M.traverseMaybeWithKey (\_ v -> v)
+    $ M.fromSet lookupFixity names
+  where
+    lookupFixity name = do
+      f <- Util.handleGhcException
+        (const $ pure Nothing)
+        (Just <$> lookupFixityRn name)
+      if f == Just defaultFixity
+      then pure Nothing
+      else pure f

haskell-language-server.cabal

@@ -691,6 +691,73 @@ 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
+  other-modules:
+    Ide.Plugin.Retrie.Imports
+  hs-source-dirs:   plugins/hls-retrie-plugin/src
+  build-depends:
+    , filepath
+    , aeson
+    , bytestring
+    , containers
+    , extra
+    , ghc
+    , ghc-boot-th
+    , ghcide                == 2.15.0.0
+    , hashable
+    , hls-plugin-api        == 2.15.0.0
+    , haskell-language-server:hls-refactor-plugin
+    , haskell-language-server:hls-exactprint-utils
+    , lens
+    , lsp
+    , lsp-types
+    , mtl
+    , retrie                >=2.0.0
+    , safe-exceptions
+    , stm
+    , syb
+    , text
+    , text-rope
+    , transformers
+    , unliftio-core
+    , 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.15.0.0
+    , text
+
 -----------------------------
 -- hlint plugin
 -----------------------------
@@ -1299,10 +1366,7 @@ library hls-explicit-fixity-plugin
   hs-source-dirs:   plugins/hls-explicit-fixity-plugin/src
   build-depends:
     , containers
-    , deepseq
-    , extra
     , ghcide                == 2.15.0.0
-    , hashable
     , hls-plugin-api        == 2.15.0.0
     , lsp                   >=2.8
     , text
@@ -1821,6 +1885,7 @@ library hls-exactprint-utils
   exposed-modules:
     Development.IDE.GHC.ExactPrint.Annotation
     Development.IDE.GHC.ExactPrint.CPP
+    Development.IDE.GHC.ExactPrint.IE
   hs-source-dirs:     hls-exactprint-utils/src
   build-depends:
     , ghc
@@ -1910,6 +1975,7 @@ library
                   , importLens
                   , caseSplit
                   , rename
+                  , retrie
                   , hlint
                   , stan
                   , signatureHelp

hls-exactprint-utils/src/Development/IDE/GHC/ExactPrint/Annotation.hs

@@ -11,6 +11,7 @@ module Development.IDE.GHC.ExactPrint.Annotation
   , removeTrailingCommaAnn
   , ensureTrailingComma
   , withTrailingComma
+  , withCommas
   , modifyAnns
   , addParens
   , parenthesizeName
@@ -85,6 +86,12 @@ ensureTrailingComma ann
   | any isCommaAnn (trailingAnns ann) = ann
   | otherwise = addComma ann
 
+-- | Add a trailing comma to every element but the last.
+withCommas :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
+withCommas []           = []
+withCommas [x]          = [x]
+withCommas (L l e : xs) = L (ensureTrailingComma l) e : withCommas xs
+
 -- | Replace an item's trailing comma with @c@, preserving its delta.
 withTrailingComma :: TrailingAnn -> SrcSpanAnnA -> SrcSpanAnnA
 withTrailingComma c = overTrailingAnns (\as -> filter (not . isCommaAnn) as ++ [c])