ghcide 2.12.0.0 → 2.13.0.0

raw patch · 23 files changed

+655/−444 lines, 23 filesdep +edit-distancedep +processdep ~hls-graphdep ~hls-plugin-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: edit-distance, process

Dependency ranges changed: hls-graph, hls-plugin-api

API changes (from Hackage documentation)

Files

• README.md +1/−331
• ghcide.cabal +7/−3
• session-loader/Development/IDE/Session.hs +5/−0
• src/Development/IDE/Core/Actions.hs +6/−15
• src/Development/IDE/Core/Compile.hs +158/−10
• src/Development/IDE/Core/LookupMod.hs +24/−0
• src/Development/IDE/Core/Preprocessor.hs +12/−0
• src/Development/IDE/Core/Rules.hs +35/−14
• src/Development/IDE/Core/Shake.hs +12/−1
• src/Development/IDE/GHC/Compat.hs +44/−2
• src/Development/IDE/GHC/Compat/Core.hs +22/−1
• src/Development/IDE/GHC/Compat/Env.hs +2/−1
• src/Development/IDE/GHC/Compat/Units.hs +26/−9
• src/Development/IDE/GHC/Orphans.hs +14/−0
• src/Development/IDE/LSP/Outline.hs +6/−0
• src/Development/IDE/Main.hs +42/−9
• src/Development/IDE/Plugin/Completions/Logic.hs +21/−11
• src/Development/IDE/Plugin/Completions/Types.hs +56/−1
• src/Development/IDE/Plugin/TypeLenses.hs +1/−0
• src/Development/IDE/Spans/AtPoint.hs +117/−30
• src/Development/IDE/Types/HscEnvEq.hs +8/−0
• src/Text/Fuzzy/Levenshtein.hs +16/−0
• src/Text/Fuzzy/Parallel.hs +20/−6

@@ -1,45 +1,5 @@ # `ghcide` - A library for building Haskell IDE tooling -Our vision is that you should build an IDE by combining:--![vscode](https://raw.githubusercontent.com/haskell/ghcide/master/img/vscode2.png)--* [`hie-bios`](https://github.com/mpickering/hie-bios) for determining where your files are, what are their dependencies, what extensions are enabled and so on;-* `ghcide` (i.e. this library) for defining how to type check, when to type check, and producing diagnostic messages;-* A bunch of plugins that haven't yet been written, e.g. [`hie-hlint`](https://github.com/ndmitchell/hlint) and [`hie-ormolu`](https://github.com/tweag/ormolu), to choose which features you want;-* [`haskell-lsp`](https://github.com/alanz/haskell-lsp) for sending those messages to a [Language Server Protocol (LSP)](https://microsoft.github.io/language-server-protocol/) server;-* An LSP client for your editor.--There are more details about our approach [in this blog post](https://4ta.uk/p/shaking-up-the-ide).--## Features--`ghcide` already exports the following features via the lsp protocol:--| Feature | LSP name |-| - | - |-| Display error messages (parse errors, typecheck errors, etc.) and enabled warnings. | diagnostics |-| Go to definition in local package | definition  |-| Display type and source module of values | hover |-| Remove redundant imports, replace suggested typos for values and module imports, fill type holes, insert missing type signatures, add suggested ghc extensions  | codeAction (quickfix) |---## Limitations to Multi-Component support--`ghcide` supports loading multiple components into the same session so that-features such as go-to definition work across components. However, there are-some limitations to this.--1. You will get much better results currently manually specifying the hie.yaml file.-Until tools like cabal and stack provide the right interface to support multi-component-projects, it is always advised to specify explicitly how your project partitions.-2. Cross-component features only work if you have loaded at least one file-from each component.-3. There is a known issue where if you have three components, such that A depends on B which depends on C-then if you load A and C into the session but not B then under certain situations you-can get strange errors about a type coming from two different places. See [this repo](https://github.com/fendor/ghcide-bad-interface-files) for-a simple reproduction of the bug.- ## Using it  `ghcide` is not an end-user tool, [don't use `ghcide`](https://neilmitchell.blogspot.com/2020/09/dont-use-ghcide-anymore-directly.html) directly (more about the rationale [here](https://github.com/haskell/ghcide/pull/939)).@@ -47,294 +7,4 @@  [`haskell-language-server`](http://github.com/haskell/haskell-language-server) is an LSP server built on top of `ghcide` with additional features and a user friendly deployment model. To get it, simply install the [Haskell extension](https://marketplace.visualstudio.com/items?itemName=haskell.haskell) in VS Code, or download prebuilt binaries from the [haskell-language-server](https://github.com/haskell/haskell-language-server) project page.  -The instructions below are meant for developers interested in setting up ghcide as an LSP server for testing purposes.--### Install `ghcide`--#### With Nix--Note that you need to compile `ghcide` with the same `ghc` as the project you are working on.--1. If the `ghc` you are using matches the version (or better is) from `nixpkgs` it‘s easiest to use the `ghcide` from `nixpkgs`. You can do so via-   ```-   nix-env -iA haskellPackages.ghcide-   ```-   or e.g. including `pkgs.haskellPackages.ghcide` in your projects `shell.nix`.-   Depending on your `nixpkgs` channel that might not be the newest `ghcide`, though.--2. If your `ghc` does not match nixpkgs you should try the [ghcide-nix repository](https://github.com/cachix/ghcide-nix)-   which provides a `ghcide` via the `haskell.nix` infrastructure.--#### With Cabal or Stack--First install the `ghcide` binary using `stack` or `cabal`, e.g.--1. `git clone https://github.com/haskell/ghcide.git`-2. `cd ghcide`-3. `cabal install` or `stack install` (and make sure `~/.local/bin` is on your `$PATH`)--It's important that `ghcide` is compiled with the same compiler you use to build your projects.--### Test `ghcide`--Next, check that `ghcide` is capable of loading your code. Change to the project directory and run `ghcide`, which will try and load everything using the same code as the IDE, but in a way that's much easier to understand. For example, taking the example of [`shake`](https://github.com/ndmitchell/shake), running `ghcide` gives some error messages and warnings before reporting at the end:--```console-Files that failed:- * .\model\Main.hs- * .\model\Model.hs- * .\model\Test.hs- * .\model\Util.hs- * .\output\docs\Main.hs- * .\output\docs\Part_Architecture_md.hs-Completed (152 worked, 6 failed)-```--Of the 158 files in Shake, as of this moment, 152 can be loaded by the IDE, but 6 can't (error messages for the reasons they can't be loaded are given earlier). The failing files are all prototype work or test output, meaning I can confidently use Shake.--The `ghcide` executable mostly relies on [`hie-bios`](https://github.com/mpickering/hie-bios) to do the difficult work of setting up your GHC environment. If it doesn't work, see [the `hie-bios` manual](https://github.com/mpickering/hie-bios#readme) to get it working. My default fallback is to figure it out by hand and create a `direct` style [`hie.yaml`](https://github.com/ndmitchell/shake/blob/master/hie.yaml) listing the command line arguments to load the project.--If you can't get `ghcide` working outside the editor, see [this setup troubleshooting guide](docs/Setup.md). Once you have got `ghcide` working outside the editor, the next step is to pick which editor to integrate with.--### Optimal project setup--`ghcide` has been designed to handle projects with hundreds or thousands of modules. If `ghci` can handle it, then `ghcide` should be able to handle it. The only caveat is that this currently requires GHC >= 8.8, and that the first time a module is loaded in the editor will trigger generation of support files in the background if those do not already exist.--### Using with VS Code--The [Haskell](https://marketplace.visualstudio.com/items?itemName=haskell.haskell) extension has a setting for ghcide.--### Using with Atom--You can follow the [instructions](https://github.com/moodmosaic/ide-haskell-ghcide#readme) to install with `apm`.--### Using with Sublime Text--* Install [LSP](https://packagecontrol.io/packages/LSP)-* Press Ctrl+Shift+P or Cmd+Shift+P in Sublime Text and search for *Preferences: LSP Settings*, then paste these settings-```-{-  "clients":-  {-    "ghcide":-    {-      "enabled"   : true,-      "languageId": "haskell",-      "command"   : ["ghcide", "--lsp"],-      "scopes"    : ["source.haskell"],-      "syntaxes"  : ["Packages/Haskell/Haskell.sublime-syntax"]-    }-  }-}-```--### Using with Emacs--If you don't already have [MELPA](https://melpa.org/#/) package installation configured, visit MELPA [getting started](https://melpa.org/#/getting-started) page to get set up. Then, install [`use-package`](https://melpa.org/#/use-package).--Now you have a choice of two different Emacs packages which can be used to communicate with the `ghcide` LSP server:--+ `lsp-ui`-+ `eglot` (requires Emacs 26.1+)--In each case, you can enable support by adding the shown lines to your `.emacs`:--#### lsp-ui--```elisp-;; LSP-(use-package flycheck-  :ensure t-  :init-  (global-flycheck-mode t))-(use-package yasnippet-  :ensure t)-(use-package lsp-mode-  :ensure t-  :hook (haskell-mode . lsp)-  :commands lsp)-(use-package lsp-ui-  :ensure t-  :commands lsp-ui-mode)-(use-package lsp-haskell- :ensure t- :config- (setq lsp-haskell-process-path-hie "ghcide")- (setq lsp-haskell-process-args-hie '())- ;; Comment/uncomment this line to see interactions between lsp client/server.- ;;(setq lsp-log-io t)-)-```--#### eglot--````elisp-(use-package eglot-  :ensure t-  :config-  (add-to-list 'eglot-server-programs '(haskell-mode . ("ghcide" "--lsp"))))-````--### Using with Vim/Neovim--#### LanguageClient-neovim-Install [LanguageClient-neovim](https://github.com/autozimu/LanguageClient-neovim)--Add this to your vim config:-```vim-let g:LanguageClient_rootMarkers = ['*.cabal', 'stack.yaml']-let g:LanguageClient_serverCommands = {-    \ 'rust': ['rls'],-    \ 'haskell': ['ghcide', '--lsp'],-    \ }-```--Refer to `:he LanguageClient` for more details on usage and configuration.--#### vim-lsp-Install [vim-lsp](https://github.com/prabirshrestha/vim-lsp).--Add this to your vim config:--```vim-au User lsp_setup call lsp#register_server({-    \ 'name': 'ghcide',-    \ 'cmd': {server_info->['/your/path/to/ghcide', '--lsp']},-    \ 'whitelist': ['haskell'],-    \ })-```--To verify it works move your cursor over a symbol and run `:LspHover`.--### coc.nvim--Install [coc.nvim](https://github.com/neoclide/coc.nvim)--Add this to your coc-settings.json (which you can edit with :CocConfig):--```json-{-  "languageserver": {-    "haskell": {-      "command": "ghcide",-      "args": [-        "--lsp"-      ],-      "rootPatterns": [-        ".stack.yaml",-        ".hie-bios",-        "BUILD.bazel",-        "cabal.config",-        "package.yaml"-      ],-      "filetypes": [-        "hs",-        "lhs",-        "haskell"-      ]-    }-  }-}-```--Here's a nice article on setting up neovim and coc: [Vim and Haskell in-2019](http://marco-lopes.com/articles/Vim-and-Haskell-in-2019/) (this is actually for haskell-ide, not ghcide)--Here is a Docker container that pins down the build and configuration for-Neovim and ghcide on a minimal Debian 10 base system:-[docker-ghcide-neovim](https://github.com/carlohamalainen/docker-ghcide-neovim/).--### SpaceVim--In the `autocomplete` layer, add the `autocomplete_method` option to force the use of `coc`:--```toml-[[layers]]-  name = 'autocomplete'-  auto-completion-return-key-behavior = "complete"-  auto-completion-tab-key-behavior = "smart"-  [options]-    autocomplete_method = "coc"-```--Add this to your coc-settings.json (which you can edit with :CocConfig):--```json-{-  "languageserver": {-    "haskell": {-      "command": "ghcide",-      "args": [-        "--lsp"-      ],-      "rootPatterns": [-        ".stack.yaml",-        ".hie-bios",-        "BUILD.bazel",-        "cabal.config",-        "package.yaml"-      ],-      "filetypes": [-        "hs",-        "lhs",-        "haskell"-      ]-    }-  }-}-```--This example above describes a setup in which `ghcide` is installed-using `stack install ghcide` within a project.--### Using with Kakoune--Install [kak-lsp](https://github.com/ul/kak-lsp).--Change `kak-lsp.toml` to include this:--```toml-[language.haskell]-filetypes = ["haskell"]-roots = ["Setup.hs", "stack.yaml", "*.cabal", "cabal.project", "hie.yaml"]-command = "ghcide"-args = ["--lsp"]-```--## Hacking on ghcide--To build and work on `ghcide` itself, you should use cabal, e.g.,-running `cabal test` will execute the test suite. You can use `stack test` too, but-note that some tests will fail, and none of the maintainers are currently using `stack`.--If you are using Nix, there is a Cachix nix-shell cache for all the supported platforms: `cachix use haskell-ghcide`.--If you are using Windows, you should disable the `auto.crlf` setting and configure your editor to use LF line endings, directly or making it use the existing `.editor-config`.--If you are chasing down test failures, you can use the tasty-rerun feature by running tests as--    cabal test --test-options"--rerun"--This writes a log file called `.tasty-rerun-log` of the failures, and only runs those.-See the [tasty-rerun](https://hackage.haskell.org/package/tasty-rerun-1.1.17/docs/Test-Tasty-Ingredients-Rerun.html) documentation for other options.--If you are touching performance sensitive code, take the time to run a differential-benchmark between HEAD and master using the benchHist script. This assumes that-"master" points to the upstream master.--Run the benchmarks with `cabal bench`.--It should take around 15 minutes and the results will be stored in the `bench-results` folder. To interpret the results, see the comments in the `bench/hist/Main.hs` module.--More details in [bench/README](bench/README.md)---## History and relationship to other Haskell IDE's--The teams behind this project and the [`haskell-ide-engine`](https://github.com/haskell/haskell-ide-engine#readme) have agreed to join forces under the [`haskell-language-server` project](https://github.com/haskell/haskell-language-server), see the [original announcement](https://neilmitchell.blogspot.com/2020/01/one-haskell-ide-to-rule-them-all.html). The technical work is ongoing, with the likely model being that this project serves as the core, while plugins and integrations are kept in the [`haskell-language-server` project](https://github.com/haskell/haskell-language-server).--The code behind `ghcide` was originally developed by [Digital Asset](https://digitalasset.com/) as part of the [DAML programming language](https://github.com/digital-asset/daml). DAML is a smart contract language targeting distributed-ledger runtimes, based on [GHC](https://www.haskell.org/ghc/) with custom language extensions. The DAML programming language has [an IDE](https://webide.daml.com/), and work was done to separate off a reusable Haskell-only IDE (what is now `ghcide`) which the [DAML IDE then builds upon](https://github.com/digital-asset/daml/tree/master/compiler/damlc). Since that time, there have been various [non-Digital Asset contributors](https://github.com/haskell/ghcide/graphs/contributors), in addition to continued investment by Digital Asset. The project has been handed over to Haskell.org as of September 2020.--The Haskell community [has](https://github.com/DanielG/ghc-mod) [various](https://github.com/chrisdone/intero) [IDE](https://github.com/rikvdkleij/intellij-haskell) [choices](http://leksah.org/), but the one that had been gathering momentum is [`haskell-ide-engine`](https://github.com/haskell/haskell-ide-engine#readme). Our project owes a debt of gratitude to the `haskell-ide-engine`. We reuse libraries from their ecosystem, including [`hie-bios`](https://github.com/mpickering/hie-bios#readme) (a likely future environment setup layer in `haskell-ide-engine`), [`haskell-lsp`](https://github.com/alanz/haskell-lsp#readme) and [`lsp-test`](https://github.com/bubba/lsp-test#readme) (the `haskell-ide-engine` [LSP protocol](https://microsoft.github.io/language-server-protocol/) pieces). We make heavy use of their contributions to GHC itself, in particular the work to make GHC take string buffers rather than files.--The best summary of the architecture of `ghcide` is available [this talk](https://www.youtube.com/watch?v=cijsaeWNf2E&list=PLxxF72uPfQVRdAsvj7THoys-nVj-oc4Ss) ([slides](https://ndmitchell.com/downloads/slides-making_a_haskell_ide-07_sep_2019.pdf)), given at [MuniHac 2019](https://munihac.de/2019.html). However, since that talk the project has renamed from `hie-core` to `ghcide`, and the repo has moved to [this location](https://github.com/haskell/ghcide/).+Set-up and usage instructions can be found on [haskell-language-server documentation](https://haskell-language-server.readthedocs.io/en/latest/components/ghcide.html)

@@ -2,7 +2,7 @@ build-type:         Simple category:           Development name:               ghcide-version:            2.12.0.0+version:            2.13.0.0 license:            Apache-2.0 license-file:       LICENSE author:             Digital Asset and Ghcide contributors@@ -60,6 +60,7 @@     , Diff                         ^>=0.5 || ^>=1.0.0     , directory     , dlist+    , edit-distance     , enummapset     , exceptions     , extra                        >=1.7.14@@ -75,8 +76,8 @@     , hashable     , hie-bios                     ^>=0.17.0     , hiedb                        ^>= 0.7.0.0-    , hls-graph                    == 2.12.0.0-    , hls-plugin-api               == 2.12.0.0+    , hls-graph                    == 2.13.0.0+    , hls-plugin-api               == 2.13.0.0     , implicit-hie                 >= 0.1.4.0 && < 0.1.5     , lens     , lens-aeson@@ -88,6 +89,7 @@     , optparse-applicative     , os-string     , parallel+    , process     , prettyprinter                >=1.7     , prettyprinter-ansi-terminal     , random@@ -131,6 +133,7 @@     Development.IDE.Core.FileStore     Development.IDE.Core.FileUtils     Development.IDE.Core.IdeConfiguration+    Development.IDE.Core.LookupMod     Development.IDE.Core.OfInterest     Development.IDE.Core.PluginUtils     Development.IDE.Core.PositionMapping@@ -196,6 +199,7 @@     Development.IDE.Types.Shake     Generics.SYB.GHC     Text.Fuzzy.Parallel+    Text.Fuzzy.Levenshtein    other-modules:     Development.IDE.Core.FileExists

@@ -885,7 +885,12 @@     hscEnv' <- -- Set up a multi component session with the other units on GHC 9.4               Compat.initUnits dfs hsc_env +#if MIN_VERSION_ghc(9,13,0)+    let closure_errs_raw = checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')+        closure_errs = concatMap (Compat.bagToList . Compat.getMessages) closure_errs_raw+#else     let closure_errs = maybeToList $ checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')+#endif         closure_err_to_multi_err err =             ideErrorWithSource                 (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp

@@ -17,13 +17,13 @@ import           Data.Maybe import qualified Data.Text                            as T import           Data.Tuple.Extra+import           Development.IDE.Core.LookupMod       (lookupMod) import           Development.IDE.Core.OfInterest import           Development.IDE.Core.PluginUtils import           Development.IDE.Core.PositionMapping import           Development.IDE.Core.RuleTypes import           Development.IDE.Core.Service import           Development.IDE.Core.Shake-import           Development.IDE.GHC.Compat           hiding (writeHieFile) import           Development.IDE.Graph import qualified Development.IDE.Spans.AtPoint        as AtPoint import           Development.IDE.Types.HscEnvEq       (hscEnv)@@ -35,19 +35,6 @@                                                        normalizedFilePathToUri,                                                        uriToNormalizedFilePath) ---- | Eventually this will lookup/generate URIs for files in dependencies, but not in the--- project. Right now, this is just a stub.-lookupMod-  :: HieDbWriter -- ^ access the database-  -> FilePath -- ^ The `.hie` file we got from the database-  -> ModuleName-  -> Unit-  -> Bool -- ^ Is this file a boot file?-  -> MaybeT IdeAction Uri-lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing-- -- IMPORTANT NOTE : make sure all rules `useWithStaleFastMT`d by these have a "Persistent Stale" rule defined, -- so we can quickly answer as soon as the IDE is opened -- Even if we don't have persistent information on disk for these rules, the persistent rule@@ -62,11 +49,15 @@   opts <- liftIO $ getIdeOptionsIO ide    (hf, mapping) <- useWithStaleFastMT GetHieAst file+  shakeExtras <- lift askShake+   env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file   dkMap <- lift $ maybe (DKMap mempty mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)-  MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'++  MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$>+    AtPoint.atPoint opts shakeExtras hf dkMap env pos'  -- | Converts locations in the source code to their current positions, -- taking into account changes that may have occurred due to edits.

@@ -149,6 +149,15 @@ import           GHC.Iface.Ext.Types                          (NameEntityInfo) #endif +#if MIN_VERSION_ghc(9,13,0)+import           GHC.Driver.Env                               (hscInsertHPT, setModuleGraph)+import           GHC.Unit.Home.Graph                          (UnitEnvGraph(..), unitEnv_assocs)+import           GHC.Unit.Home.PackageTable                   (hptInternalTableRef, hptInternalTableFromRef)+import           GHC.Unit.Module.ModIface                     (IfaceTopEnv(..))+import           GHC.Types.Avail                              (emptyDetOrdAvails)+import           GHC.Types.Basic                              (ImportLevel(..))+#endif+ #if MIN_VERSION_ghc(9,12,0) import           Development.IDE.Import.FindImports #endif@@ -311,7 +320,11 @@                                          , moduleUnitId mod `elem` home_unit_ids -- Only care about stuff from the home package set                                          ]                  home_unit_ids =+#if MIN_VERSION_ghc(9,13,0)+                    map fst (unitEnv_assocs $ hsc_HUG hsc_env)+#else                     map fst (hugElts $ hsc_HUG hsc_env)+#endif                  mods_transitive = getTransitiveMods hsc_env needed_mods                   -- If we don't support multiple home units, ModuleNames are sufficient because all the units will be the same@@ -323,7 +336,11 @@                                  | installedMod <- mods_transitive_list                                  , let file = fromJust $ lookupModuleFile (installedMod { moduleUnit = RealUnit (Definite $ moduleUnit installedMod) }) moduleLocs                                  ]+#if MIN_VERSION_ghc(9,13,0)+           ; hsc_env' <- loadModulesHome (map linkableHomeMod lbs) hsc_env+#else            ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env+#endif               {- load it -} #if MIN_VERSION_ghc(9,11,0)@@ -333,7 +350,11 @@ #else            ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos #endif+#if MIN_VERSION_ghc(9,13,0)+           ; let hval = (expectJust $ lookup (idName binding_id) fv_hvs, lbss, pkgs)+#else            ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs, lbss, pkgs)+#endif             ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb])            ; return hval }@@ -351,10 +372,19 @@      -- Compute the transitive set of linkables required     getTransitiveMods hsc_env needed_mods+#if MIN_VERSION_ghc(9,13,0)+      = Set.unions (Set.fromList (map moduleToNodeKey mods) : [ Set.fromList $ map mkNodeKey dep+                                                              | m <- mods+                                                              , Just dep <-+                                                                  [mgReachable (hsc_mod_graph hsc_env) (moduleToNodeKey m)]+                                                              ])+      where mods = nonDetEltsUniqSet needed_mods -- OK because we put them into a set immediately after+#else       = Set.unions (Set.fromList (map moduleToNodeKey mods) : [ dep | m <- mods                                                               , Just dep <- [Map.lookup (moduleToNodeKey m) (mgTransDeps (hsc_mod_graph hsc_env))]                                                               ])       where mods = nonDetEltsUniqSet needed_mods -- OK because we put them into a set immediately after+#endif      -- | Add a Hook to the DynFlags which captures and returns the     -- typechecked splices before they are run. This information@@ -458,7 +488,9 @@   iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv   -- See Note [Clearing mi_globals after generating an iface]   let iface = iface'-#if MIN_VERSION_ghc(9,11,0)+#if MIN_VERSION_ghc(9,13,0)+                & set_mi_top_env (IfaceTopEnv emptyDetOrdAvails [])+#elif MIN_VERSION_ghc(9,11,0)                 & set_mi_top_env Nothing                 & set_mi_usages (filterUsages (mi_usages iface')) #else@@ -483,6 +515,14 @@         (guts, details) <- tidyProgram tidy_opts simplified_guts         pure (details, guts) +#if MIN_VERSION_ghc(9,13,0)+  partial_iface <- mkPartialIface session+                                  (cg_binds guts)+                                  details+                                  ms+                                  (tcg_import_decls (tmrTypechecked tcm))+                                  simplified_guts+#else   let !partial_iface = force $ mkPartialIface session                                               (cg_binds guts)                                               details@@ -491,6 +531,7 @@                                               (tcg_import_decls (tmrTypechecked tcm)) #endif                                               simplified_guts+#endif    final_iface' <- mkFullIface session partial_iface Nothing                     Nothing@@ -499,7 +540,9 @@ #endif   -- See Note [Clearing mi_globals after generating an iface]   let final_iface = final_iface'-#if MIN_VERSION_ghc(9,11,0)+#if MIN_VERSION_ghc(9,13,0)+                      & set_mi_top_env (IfaceTopEnv emptyDetOrdAvails [])+#elif MIN_VERSION_ghc(9,11,0)                       & set_mi_top_env Nothing                       & set_mi_usages (filterUsages (mi_usages final_iface')) #else@@ -532,19 +575,35 @@       traceIO $ "Verifying " ++ core_fp       let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts           mod = ms_mod ms-          data_tycons = filter isDataTyCon tycons+          data_tycons = filter isAlgTyCon tycons       CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core       cp_cfg <- initCorePrepConfig session+#if MIN_VERSION_ghc(9,13,0)       let corePrep = corePrepPgm                        (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session))+                       mod++      -- Run corePrep first as we want to test the final version of the program that will+      -- get translated to STG/Bytecode+      prepd_binds+        <- corePrep unprep_binds+#else+      let corePrep = corePrepPgm+                       (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session))                        mod (ms_location ms)        -- Run corePrep first as we want to test the final version of the program that will       -- get translated to STG/Bytecode       prepd_binds         <- corePrep unprep_binds data_tycons+#endif+#if MIN_VERSION_ghc(9,13,0)       prepd_binds'+        <- corePrep unprep_binds'+#else+      prepd_binds'         <- corePrep unprep_binds' data_tycons+#endif       let binds  = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds           binds' = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds' @@ -987,6 +1046,31 @@           -> [HscEnv]           -> IO HscEnv mergeEnvs env mg dep_info ms extraMods envs = do+#if MIN_VERSION_ghc(9,13,0)+      newHug <- sequence $ foldl' mergeHUG (pure <$> hsc_HUG env) (map (fmap pure . hsc_HUG) envs)+      let hsc_env' = setModuleGraph mg $ (hscUpdateHUG (const newHug) env){+                hsc_FC = (hsc_FC env)+                  { addToFinderCache = \im val ->+                        if moduleUnit im `elem` hsc_all_home_unit_ids env+                        then pure ()+                        else addToFinderCache (hsc_FC env) im val+                  , lookupFinderCache = \im ->+                        if moduleUnit im `elem` hsc_all_home_unit_ids env+                        then case lookupModuleFile (im { moduleUnit = RealUnit (Definite $ moduleUnit im) }) dep_info of+                               Nothing -> pure Nothing+                               Just fs -> let ml = fromJust $ do+                                                    id <- lookupPathToId (depPathIdMap dep_info) fs+                                                    artifactModLocation (idToModLocation (depPathIdMap dep_info) id)+#if MIN_VERSION_ghc(9,13,0)+                                          in pure $ Just $ InstalledFound ml+#else+                                          in pure $ Just $ InstalledFound ml im+#endif+                        else lookupFinderCache (hsc_FC env) im+                  }+            }+      loadModulesHome extraMods hsc_env'+#else     return $! loadModulesHome extraMods $       let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in       (hscUpdateHUG (const newHug) env){@@ -1007,15 +1091,31 @@                   else lookupFinderCache (hsc_FC env) gwib             }       }+#endif      where+#if MIN_VERSION_ghc(9,13,0)+        mergeHUG :: UnitEnvGraph (IO HomeUnitEnv) -> UnitEnvGraph (IO HomeUnitEnv) -> UnitEnvGraph (IO HomeUnitEnv)         mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b+        mergeHUE a b = do+          a_v <- a+          hpt_b <- readIORef . hptInternalTableRef . homeUnitEnv_hpt =<< b+          hpt_a <- readIORef . hptInternalTableRef . homeUnitEnv_hpt $ a_v+          result <- hptInternalTableFromRef =<< (newIORef $! mergeUDFM hpt_a hpt_b)+          return $! a_v { homeUnitEnv_hpt = result }+        mergeUDFM = plusUDFM_C combineModules+        combineModules a b+          | HsSrcFile <- mi_hsc_src (hm_iface a) = a+          | otherwise = b+#else+        mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b         mergeHUE a b = a { homeUnitEnv_hpt = mergeUDFM (homeUnitEnv_hpt a) (homeUnitEnv_hpt b) }         mergeUDFM = plusUDFM_C combineModules          combineModules a b           | HsSrcFile <- mi_hsc_src (hm_iface a) = a           | otherwise = b+#endif  #else mergeEnvs :: HscEnv@@ -1112,8 +1212,14 @@          rn_pkg_qual = renameRawPkgQual (hsc_unit_env ppEnv)         rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn))+#if MIN_VERSION_ghc(9,13,0)+        -- In GHC 9.13+, ms_srcimps is just [Located ModuleName] and ms_textual_imps includes ImportLevel+        srcImports = map snd $ rn_imps $ map convImport src_idecls+        textualImports = map (\(pk, lmn) -> (NormalLevel, pk, lmn)) $ rn_imps $ map convImport (implicit_imports ++ ordinary_imps)+#else         srcImports = rn_imps $ map convImport src_idecls         textualImports = rn_imps $ map convImport (implicit_imports ++ ordinary_imps)+#endif         ghc_prim_import = not (null _ghc_prim_imports)  @@ -1135,7 +1241,9 @@                 { ms_mod          = modl                 , ms_hie_date     = Nothing                 , ms_dyn_obj_date    = Nothing+#if !MIN_VERSION_ghc(9,13,0)                 , ms_ghc_prim_import = ghc_prim_import+#endif                 , ms_hs_hash      = _src_hash                  , ms_hsc_src      = sourceType@@ -1160,12 +1268,24 @@         computeFingerprint opts ModSummary{..} = do             fingerPrintImports <- fingerprintFromPut $ do                   put $ Util.uniq $ moduleNameFS $ moduleName ms_mod+#if MIN_VERSION_ghc(9,13,0)+                  -- In GHC 9.13+, ms_srcimps is [Located ModuleName] and ms_textual_imps is [(ImportLevel, PkgQual, Located ModuleName)]+                  forM_ ms_srcimps $ \m -> do+                    put $ Util.uniq $ moduleNameFS $ unLoc m+                  forM_ ms_textual_imps $ \(_lvl, mb_p, m) -> do+                    put $ Util.uniq $ moduleNameFS $ unLoc m+                    case mb_p of+                      G.NoPkgQual    -> pure ()+                      G.ThisPkg uid  -> put $ getKey $ getUnique uid+                      G.OtherPkg uid -> put $ getKey $ getUnique uid+#else                   forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do                     put $ Util.uniq $ moduleNameFS $ unLoc m                     case mb_p of                       G.NoPkgQual    -> pure ()                       G.ThisPkg uid  -> put $ getKey $ getUnique uid                       G.OtherPkg uid -> put $ getKey $ getUnique uid+#endif             return $! Util.fingerprintFingerprints $                     [ Util.fingerprintString fp                     , fingerPrintImports@@ -1421,7 +1541,11 @@         -- ncu and read_dflags are only used in GHC >= 9.4         let _ncu = hsc_NC sessionWithMsDynFlags             _read_dflags = hsc_dflags sessionWithMsDynFlags+#if MIN_VERSION_ghc(9,13,0)+        read_result <- liftIO $ readIface (hsc_hooks sessionWithMsDynFlags) (hsc_logger sessionWithMsDynFlags) _read_dflags _ncu mod iface_file+#else         read_result <- liftIO $ readIface _read_dflags _ncu mod iface_file+#endif         case read_result of           Util.Failed{}        -> return Nothing           -- important to call `shareUsages` here before checkOldIface@@ -1445,9 +1569,13 @@       (Just iface, UpToDate) -> do              details <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface              -- parse the runtime dependencies from the annotations-             let runtime_deps-                   | not (mi_used_th iface) = emptyModuleEnv-                   | otherwise = parseRuntimeDeps (md_anns details)+             let runtime_deps =+#if MIN_VERSION_ghc(9,13,0)+                   parseRuntimeDeps (md_anns details)+#else+                   if not (mi_used_th iface) then emptyModuleEnv+                   else parseRuntimeDeps (md_anns details)+#endif              -- Peform the fine grained recompilation check for TH              maybe_recomp <- checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps              case maybe_recomp of@@ -1517,18 +1645,30 @@ mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails mkDetailsFromIface session iface = do   fixIO $ \details -> do+#if MIN_VERSION_ghc(9,13,0)+    hscInsertHPT (HomeModInfo iface details emptyHomeModInfoLinkable) session+    initIfaceLoad session (typecheckIface iface)+#else     let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session     initIfaceLoad hsc' (typecheckIface iface)+#endif  coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts coreFileToCgGuts session iface details core_file = do+  let this_mod = mi_module iface+  types_var <- newIORef (md_types details)+#if MIN_VERSION_ghc(9,13,0)+  let hsc_env' = session {+        hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)])+        }+  hscInsertHPT (HomeModInfo iface details emptyHomeModInfoLinkable) hsc_env'+#else   let act hpt = addToHpt hpt (moduleName this_mod)                              (HomeModInfo iface details emptyHomeModInfoLinkable)-      this_mod = mi_module iface-  types_var <- newIORef (md_types details)-  let hsc_env' = hscUpdateHPT act (session {+      hsc_env' = hscUpdateHPT act (session {         hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)])         })+#endif   core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckCoreFile this_mod types_var core_file       -- Implicit binds aren't saved, so we need to regenerate them ourselves.   let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6@@ -1615,7 +1755,15 @@ -- error out when we don't find it setNonHomeFCHook :: HscEnv -> HscEnv setNonHomeFCHook hsc_env =-#if MIN_VERSION_ghc(9,11,0)+#if MIN_VERSION_ghc(9,13,0)+  hsc_env { hsc_FC = (hsc_FC hsc_env)+                        { lookupFinderCache = \im ->+                            if moduleUnit im `elem` hsc_all_home_unit_ids hsc_env+                            then pure (Just $ InstalledNotFound [] Nothing)+                            else lookupFinderCache (hsc_FC hsc_env) im+                        }+          }+#elif MIN_VERSION_ghc(9,11,0)   hsc_env { hsc_FC = (hsc_FC hsc_env)                         { lookupFinderCache = \m@(GWIB im _) ->                             if moduleUnit im `elem` hsc_all_home_unit_ids hsc_env

@@ -0,0 +1,24 @@+module Development.IDE.Core.LookupMod (lookupMod, LookupModule) where++import           Control.Monad.Trans.Maybe       (MaybeT (MaybeT))+import           Development.IDE.Core.Shake      (HieDbWriter, IdeAction)+import           Development.IDE.GHC.Compat.Core (ModuleName, Unit)+import           Development.IDE.Types.Location  (Uri)++-- | Gives a Uri for the module, given the .hie file location and the the module info+-- The Bool denotes if it is a boot module+type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri++-- | Eventually this will lookup/generate URIs for files in dependencies, but not in the+-- project. Right now, this is just a stub.+lookupMod ::+  -- | access the database+  HieDbWriter ->+  -- | The `.hie` file we got from the database+  FilePath ->+  ModuleName ->+  Unit ->+  -- | Is this file a boot file?+  Bool ->+  MaybeT IdeAction Uri+lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing

@@ -30,6 +30,9 @@ import qualified GHC.LanguageExtensions            as LangExt import qualified GHC.Runtime.Loader                as Loader import           GHC.Utils.Logger                  (LogFlags (..))+#if MIN_VERSION_ghc(9,13,0)+import           GHC.Driver.Config.Parser          (supportedLanguagePragmas)+#endif import           System.FilePath import           System.IO.Extra @@ -144,12 +147,21 @@     -> Util.StringBuffer     -> IO (Either [FileDiagnostic] ([String], HscEnv)) parsePragmasIntoHscEnv env fp contents = catchSrcErrors dflags0 "pragmas" $ do+#if MIN_VERSION_ghc(9,13,0)+    let supportedExts = supportedLanguagePragmas dflags0+    let (_warns,opts) = getOptions (initParserOpts dflags0) supportedExts contents fp+#else     let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp+#endif      -- Force bits that might keep the dflags and stringBuffer alive unnecessarily     evaluate $ rnf opts +#if MIN_VERSION_ghc(9,13,0)+    (dflags, _, _) <- parseDynamicFilePragma (hsc_logger env) dflags0 opts+#else     (dflags, _, _) <- parseDynamicFilePragma dflags0 opts+#endif     hsc_env' <- Loader.initializePlugins (hscSetFlags dflags env)     return (map unLoc opts, hscSetFlags (disableWarningsAsErrors $ hsc_dflags hsc_env') hsc_env')   where dflags0 = hsc_dflags env

@@ -141,6 +141,10 @@ import           GHC.Iface.Ext.Types                          (HieASTs (..)) import           GHC.Iface.Ext.Utils                          (generateReferencesMap) import qualified GHC.LanguageExtensions                       as LangExt+#if MIN_VERSION_ghc(9,13,0)+import           GHC.Types.PkgQual                            (PkgQual (NoPkgQual))+import           GHC.Types.Basic                              (ImportLevel (NormalLevel))+#endif import           HIE.Bios.Ghc.Gap                             (hostIsDynamic) import qualified HieDb import           Ide.Logger                                   (Pretty (pretty),@@ -183,7 +187,6 @@   | LogLoadingHieFileFail !FilePath !SomeException   | LogLoadingHieFileSuccess !FilePath   | LogTypecheckedFOI !NormalizedFilePath-  | LogDependencies !NormalizedFilePath [FilePath]   deriving Show  instance Pretty Log where@@ -208,11 +211,6 @@         <+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"         <+> "triggered this warning."       ]-    LogDependencies nfp deps ->-      vcat-         [ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)-         , nest 2 $ pretty deps-         ]  templateHaskellInstructions :: T.Text templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"@@ -321,7 +319,12 @@     define (cmapWithPrio LogShake recorder) $ \GetLocatedImports file -> do         ModSummaryResult{msrModSummary = ms} <- use_ GetModSummaryWithoutTimestamps file         (KnownTargets targets targetsMap) <- useNoFile_ GetKnownTargets+#if MIN_VERSION_ghc(9,13,0)+        let imports = [(False, lvl, mbPkgName, modName) | (lvl, mbPkgName, modName) <- ms_textual_imps ms]+                   ++ [(True, NormalLevel, NoPkgQual, noLoc modName) | L _ modName <- ms_srcimps ms]+#else         let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]+#endif         env_eq <- use_ GhcSession file         let env = hscEnv env_eq         let import_dirs = map (second homeUnitEnv_dflags) $ hugElts $ hsc_HUG env@@ -341,7 +344,11 @@                 | otherwise = do                     itExists <- getFileExists nfp                     return $ if itExists then Just nfp else Nothing+#if MIN_VERSION_ghc(9,13,0)+        (diags, imports') <- fmap unzip $ forM imports $ \(isSource, _lvl, mbPkgName, modName) -> do+#else         (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do+#endif             diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource             case diagOrImp of                 Left diags              -> pure (diags, Just (modName, Nothing))@@ -641,10 +648,17 @@   let deps = map (\i -> IM.lookup (getFilePathId i) (rawImports rawDepInfo)) _all_ids       nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi mms -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss       mns = catMaybes $ zipWith go mss deps+#if MIN_VERSION_ghc(9,13,0)+      go (Just ms) (Just (Right (ModuleImports xs))) = Just $ ModuleNode this_dep_edges (ModuleNodeCompile ms)+        where this_dep_ids = mapMaybe snd xs+              this_dep_edges = map mkNormalEdge $ mapMaybe (\fi -> IM.lookup (getFilePathId fi) nodeKeys) this_dep_ids+      go (Just ms) _ = Just $ ModuleNode [] (ModuleNodeCompile ms)+#else       go (Just ms) (Just (Right (ModuleImports xs))) = Just $ ModuleNode this_dep_keys ms         where this_dep_ids = mapMaybe snd xs               this_dep_keys = mapMaybe (\fi -> IM.lookup (getFilePathId fi) nodeKeys) this_dep_ids       go (Just ms) _ = Just $ ModuleNode [] ms+#endif       go _ _ = Nothing       mg = mkModuleGraph mns   let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of@@ -722,7 +736,7 @@                 itExists <- getFileExists nfp                 when itExists $ void $ do                   use_ GetPhysicalModificationTime nfp-        logWith recorder Logger.Info $ LogDependencies file deps+         mapM_ addDependency deps          let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))@@ -750,18 +764,20 @@     :: -- | full mod summary         Bool ->         GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)-ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do-    let hsc = hscEnv env-+ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} hscEnvEq file = do     mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file     case mbdeps of         Nothing -> return Nothing         Just deps -> do             when fullModuleGraph $ void $ use_ ReportImportCycles file-            ms <- msrModSummary <$> if fullModSummary+            msr <- if fullModSummary                 then use_ GetModSummary file                 else use_ GetModSummaryWithoutTimestamps file-+            let+                ms = msrModSummary msr+                -- This `HscEnv` has its plugins initialized in `parsePragmasIntoHscEnv`+                -- Fixes the bug in #4631+                env = msrHscEnv msr             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps             ifaces <- uses_ GetModIface deps             let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces@@ -777,18 +793,23 @@                 !final_deps <- do                   dep_mss <- map msrModSummary <$> uses_ GetModSummaryWithoutTimestamps deps                   return $!! map (NodeKey_Module . msKey) dep_mss+#if MIN_VERSION_ghc(9,13,0)                 let module_graph_nodes =+                      nubOrdOn mkNodeKey (ModuleNode (map mkNormalEdge final_deps) (ModuleNodeCompile ms) : concatMap mgModSummaries' mgs)+#else+                let module_graph_nodes =                       nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)+#endif                 liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes                 return $ mkModuleGraph module_graph_nodes-            session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions+            session' <- liftIO $ mergeEnvs env mg de ms inLoadOrder depSessions              -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new             -- ExportsMap when it is called. We only need to create the ExportsMap once per             -- session, while `ghcSessionDepsDefinition` will be called for each file we need             -- to compile. `updateHscEnvEq` will refresh the HscEnv (session') and also             -- generate a new Unique.-            Just <$> liftIO (updateHscEnvEq env session')+            Just <$> liftIO (updateHscEnvEq hscEnvEq session')  -- | Load a iface from disk, or generate it if there isn't one or it is out of date -- This rule also ensures that the `.hie` and `.o` (if needed) files are written out.

@@ -76,7 +76,8 @@     Log(..),     VFSModified(..), getClientConfigAction,     ThreadQueue(..),-    runWithSignal+    runWithSignal,+    askShake     ) where  import           Control.Concurrent.Async@@ -132,10 +133,16 @@  import           Development.IDE.Core.Tracing import           Development.IDE.Core.WorkerThread+#if MIN_VERSION_ghc(9,13,0) import           Development.IDE.GHC.Compat             (NameCache,                                                          NameCacheUpdater,+                                                         newNameCache)+#else+import           Development.IDE.GHC.Compat             (NameCache,+                                                         NameCacheUpdater,                                                          initNameCache,                                                          knownKeyNames)+#endif import           Development.IDE.GHC.Orphans            () import           Development.IDE.Graph                  hiding (ShakeValue,                                                          action)@@ -665,7 +672,11 @@         restartQueue = tRestartQueue threadQueue         loaderQueue = tLoaderQueue threadQueue +#if MIN_VERSION_ghc(9,13,0)+    ideNc <- newNameCache+#else     ideNc <- initNameCache 'r' knownKeyNames+#endif     shakeExtras <- do         globals <- newTVarIO HMap.empty         state <- STM.newIO

@@ -66,6 +66,7 @@     simplifyExpr,     tidyExpr,     emptyTidyEnv,+    tidyOpenType,     corePrepExpr,     corePrepPgm,     lintInteractiveExpr,@@ -73,6 +74,7 @@     HomePackageTable,     lookupHpt,     loadModulesHome,+    hugElts,     bcoFreeNames,     ModIfaceAnnotation,     pattern Annotation,@@ -87,7 +89,9 @@     emptyInScopeSet,     Unfolding(..),     noUnfolding,+#if !MIN_VERSION_ghc(9,13,0)     loadExpr,+#endif     byteCodeGen,     bc_bcos,     loadDecls,@@ -135,6 +139,7 @@  import qualified GHC.Core.Opt.Pipeline                   as GHC import           GHC.Core.Tidy                           (tidyExpr)+import           GHC.Core.TyCo.Tidy                      (tidyOpenType) import           GHC.CoreToStg.Prep                      (corePrepPgm) import qualified GHC.CoreToStg.Prep                      as GHC import           GHC.Driver.Hooks                        (hscCompileCoreExprHook)@@ -173,7 +178,11 @@ import           GHC.Driver.Config.Stg.Pipeline import           GHC.Driver.Env                          as Env import           GHC.Iface.Env-import           GHC.Linker.Loader                       (loadDecls, loadExpr)+import           GHC.Linker.Loader                       (loadDecls+#if !MIN_VERSION_ghc(9,13,0)+                                                         , loadExpr+#endif+                                                         ) import           GHC.Runtime.Context                     (icInteractiveModule) import           GHC.Stg.Pipeline import           GHC.Stg.Syntax@@ -181,14 +190,23 @@ import           GHC.Types.CostCentre import           GHC.Types.IPE import           GHC.Types.SrcLoc                        (combineRealSrcSpans)+#if MIN_VERSION_ghc(9,13,0)+import           GHC.Unit.Home.PackageTable              (HomePackageTable,+                                                          lookupHpt)+#else import           GHC.Unit.Home.ModInfo                   (HomePackageTable,                                                           lookupHpt)+#endif import           GHC.Unit.Module.Deps                    (Dependencies (dep_direct_mods),                                                           Usage (..)) import           GHC.Unit.Module.ModIface  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] +#if MIN_VERSION_ghc(9,13,0)+import           GHC.Unit.Home.Graph                     (addHomeModInfoToHug, unitEnv_assocs)+#endif+ #if MIN_VERSION_ghc(9,7,0) import           GHC.Tc.Zonk.TcType                      (tcInitTidyEnv) #endif@@ -265,7 +283,11 @@ #endif  getDependentMods :: ModIface -> [ModuleName]+#if MIN_VERSION_ghc(9,13,0)+getDependentMods = map (gwib_mod . (\(_,_,x) -> x)) . S.toList . dep_direct_mods . mi_deps+#else getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps+#endif  simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr simplifyExpr _ env = GHC.simplifyExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) (ue_eps (Development.IDE.GHC.Compat.Env.hsc_unit_env env)) (initSimplifyExprOpts (hsc_dflags env) (hsc_IC env))@@ -360,7 +382,11 @@   getModuleHash :: ModIface -> Fingerprint+#if MIN_VERSION_ghc(9,13,0)+getModuleHash = mi_mod_hash+#else getModuleHash = mi_mod_hash . mi_final_exts+#endif   disableWarningsAsErrors :: DynFlags -> DynFlags@@ -411,13 +437,16 @@   | GHC98   | GHC910   | GHC912+  | GHC914   deriving (Eq, Ord, Show, Enum)  ghcVersionStr :: String ghcVersionStr = VERSION_ghc  ghcVersion :: GhcVersion-#if MIN_VERSION_GLASGOW_HASKELL(9,12,0,0)+#if MIN_VERSION_GLASGOW_HASKELL(9,14,0,0)+ghcVersion = GHC914+#elif MIN_VERSION_GLASGOW_HASKELL(9,12,0,0) ghcVersion = GHC912 #elif MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) ghcVersion = GHC910@@ -455,9 +484,22 @@ loadModulesHome     :: [HomeModInfo]     -> HscEnv+#if MIN_VERSION_ghc(9,13,0)+    -> IO HscEnv+loadModulesHome mod_infos e = do+  let hug = hsc_HUG (e { hsc_type_env_vars = emptyKnotVars })+  mapM_ (`addHomeModInfoToHug` hug) mod_infos+  pure (e { hsc_type_env_vars = emptyKnotVars })+#else     -> HscEnv loadModulesHome mod_infos e =   hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })+#endif++#if MIN_VERSION_ghc(9,13,0)+hugElts :: HomeUnitGraph -> [(UnitId, HomeUnitEnv)]+hugElts = unitEnv_assocs+#endif  recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int recDotDot x =

@@ -72,8 +72,10 @@ #if MIN_VERSION_ghc(9,11,0)     pattern ModIface,     set_mi_top_env,+#if !MIN_VERSION_ghc(9,13,0)     set_mi_usages, #endif+#endif     HscSource(..),     WhereFrom(..),     loadInterface,@@ -522,6 +524,9 @@ import qualified GHC.Unit.Finder             as GHC import           GHC.Unit.Finder.Types import           GHC.Unit.Home.ModInfo+#if MIN_VERSION_ghc(9,13,0)+import           GHC.Unit.Home.PackageTable  (addToHpt, addListToHpt)+#endif import           GHC.Unit.Module.Graph import           GHC.Unit.Module.Imported import           GHC.Unit.Module.ModDetails@@ -534,8 +539,10 @@ #if MIN_VERSION_ghc(9,11,0)                                              , pattern ModIface                                              , set_mi_top_env+#if !MIN_VERSION_ghc(9,13,0)                                              , set_mi_usages #endif+#endif                                              ) import           GHC.Unit.Module.ModSummary  (ModSummary (..)) import           GHC.Utils.Error             (mkPlainErrorMsgEnvelope)@@ -550,6 +557,10 @@ import System.OsPath #endif +#if MIN_VERSION_ghc(9,13,0)+import qualified System.FilePath as FP+#endif+ #if !MIN_VERSION_ghc(9,7,0) import           GHC.Types.Avail             (greNamePrintableName) #endif@@ -559,7 +570,17 @@ #endif  mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation-#if MIN_VERSION_ghc(9,11,0)+#if MIN_VERSION_ghc(9,13,0)+mkHomeModLocation df mn f =+  let (basename, ext) = FP.splitExtension f+      osBasename = unsafeEncodeUtf basename+      osExt = unsafeEncodeUtf ext+      hscSrc = case ext of+        ".hs-boot" -> HsBootFile+        ".hsig" -> HsigFile+        _ -> HsSrcFile+  in pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn osBasename osExt hscSrc+#elif MIN_VERSION_ghc(9,11,0) mkHomeModLocation df mn f =   let osf = unsafeEncodeUtf f   in pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn osf

@@ -3,9 +3,10 @@ -- | Compat module for the main Driver types, such as 'HscEnv', -- 'UnitEnv' and some DynFlags compat functions. module Development.IDE.GHC.Compat.Env (-    Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph+    Env.HscEnv(hsc_FC, hsc_NC, hsc_IC               , hsc_type_env_vars               ),+    Env.hsc_mod_graph,     Env.hsc_HPT,     InteractiveContext(..),     setInteractivePrintName,

@@ -75,26 +75,40 @@ import qualified GHC.Unit.State                        as State import           GHC.Unit.Types +#if MIN_VERSION_ghc(9,13,0)+import qualified Data.Set                              as Set+import           GHC.Unit.Home.Graph+import           GHC.Unit.Home.PackageTable            (emptyHomePackageTable)+import           GHC.Unit.Module.Graph                 (emptyMG)+#endif + type PreloadUnitClosure = UniqSet UnitId  unitState :: HscEnv -> UnitState unitState = ue_units . hsc_unit_env -createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> HomeUnitGraph-createUnitEnvFromFlags unitDflags =-  let-    newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing-    unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags-  in-    unitEnv_new (Map.fromList (NE.toList unitEnvList))+createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> IO HomeUnitGraph+createUnitEnvFromFlags unitDflags = do+#if MIN_VERSION_ghc(9,13,0)+  let mkEntry dflags = do+        hpt <- emptyHomePackageTable+        let us = State.emptyUnitState -- placeholder UnitState+        pure (homeUnitId_ dflags, mkHomeUnitEnv us Nothing dflags hpt Nothing)+  unitEnvList <- mapM mkEntry (NE.toList unitDflags)+  pure $ unitEnv_new (Map.fromList unitEnvList)+#else+  let newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing+      unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags+  pure $ unitEnv_new (Map.fromList (NE.toList unitEnvList))+#endif  initUnits :: [DynFlags] -> HscEnv -> IO HscEnv initUnits unitDflags env = do   let dflags0         = hsc_dflags env   -- additionally, set checked dflags so we don't lose fixes-  let initial_home_graph = createUnitEnvFromFlags (dflags0 NE.:| unitDflags)-      home_units = unitEnv_keys initial_home_graph+  initial_home_graph <- createUnitEnvFromFlags (dflags0 NE.:| unitDflags)+  let home_units = unitEnv_keys initial_home_graph   home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do     let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv         dflags = homeUnitEnv_dflags homeUnitEnv@@ -118,6 +132,9 @@         , ue_home_unit_graph = home_unit_graph         , ue_current_unit    = homeUnitId_ dflags0         , ue_eps             = ue_eps (hsc_unit_env env)+#if MIN_VERSION_ghc(9,13,0)+        , ue_module_graph    = emptyMG+#endif         }   pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env 

@@ -26,6 +26,9 @@ import           GHC.Parser.Annotation import           GHC.Types.PkgQual import           GHC.Types.SrcLoc+#if MIN_VERSION_ghc(9,13,0)+import           GHC.Types.Basic                   (ImportLevel)+#endif  -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -44,7 +47,9 @@ instance NFData CgGuts where rnf = rwhnf 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+#endif instance Show Linkable where show = unpack . printOutputable #if MIN_VERSION_ghc(9,11,0) instance NFData Linkable where rnf (Linkable a b c) = rnf a `seq` rnf b `seq` rnf c@@ -136,8 +141,10 @@ instance NFData a => NFData (IdentifierDetails a) where     rnf (IdentifierDetails a b) = rnf a `seq` rnf (length b) +#if !MIN_VERSION_ghc(9,13,0) instance NFData RealSrcSpan where     rnf = rwhnf+#endif  srcSpanFileTag, srcSpanStartLineTag, srcSpanStartColTag,     srcSpanEndLineTag, srcSpanEndColTag :: String@@ -209,8 +216,10 @@   rnf (ThisPkg uid)  = rnf uid   rnf (OtherPkg uid) = rnf uid +#if !MIN_VERSION_ghc(9,13,0) instance NFData UnitId where   rnf = rwhnf+#endif  instance NFData NodeKey where   rnf = rwhnf@@ -235,3 +244,8 @@  instance NFData (UniqFM Name [Name]) where   rnf (ufmToIntMap -> m) = rnf m++#if MIN_VERSION_ghc(9,13,0)+instance NFData ImportLevel where+  rnf = rwhnf+#endif

@@ -256,8 +256,14 @@ #endif     get_flds_gadt _                   = [] +#if MIN_VERSION_ghc(9,13,0)+    get_flds :: Located [LHsConDeclRecField GhcPs]+             -> [LFieldOcc GhcPs]+    get_flds flds = concatMap (cdrf_names . unLoc) (unLoc flds)+#else     get_flds :: Located [LConDeclField GhcPs]              -> [LFieldOcc GhcPs]     get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds)+#endif  

@@ -15,6 +15,7 @@ import           Control.Concurrent.MVar                  (MVar, newEmptyMVar,                                                            putMVar, tryReadMVar) import           Control.Concurrent.STM.Stats             (dumpSTMStats)+import           Control.Exception.Safe                   as Safe import           Control.Monad.Extra                      (concatMapM, unless,                                                            when) import           Control.Monad.IO.Class                   (liftIO)@@ -114,16 +115,17 @@ import           Numeric.Natural                          (Natural) import           Options.Applicative                      hiding (action) import qualified System.Directory.Extra                   as IO-import           System.Exit                              (ExitCode (ExitFailure),+import           System.Exit                              (ExitCode (ExitFailure, ExitSuccess),                                                            exitWith) import           System.FilePath                          (takeExtension,-                                                           takeFileName)+                                                           takeFileName, (</>)) import           System.IO                                (BufferMode (LineBuffering, NoBuffering),                                                            Handle, hFlush,                                                            hPutStrLn,                                                            hSetBuffering,                                                            hSetEncoding, stderr,                                                            stdin, stdout, utf8)+import           System.Process                           (readProcessWithExitCode) import           System.Random                            (newStdGen) import           System.Time.Extra                        (Seconds, offsetTime,                                                            showDuration)@@ -141,6 +143,7 @@   | LogSession Session.Log   | LogPluginHLS PluginHLS.Log   | LogRules Rules.Log+  | LogUsingGit   deriving Show  instance Pretty Log where@@ -164,6 +167,7 @@     LogSession msg -> pretty msg     LogPluginHLS msg -> pretty msg     LogRules msg -> pretty msg+    LogUsingGit -> "Using git to list file, relying on .gitignore"  data Command     = Check [FilePath]  -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures@@ -383,7 +387,7 @@             putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues"              putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir-            files <- expandFiles (argFiles ++ ["." | null argFiles])+            files <- expandFiles recorder (argFiles ++ ["." | null argFiles])             -- LSP works with absolute file paths, so try and behave similarly             absoluteFiles <- nubOrd <$> mapM IO.canonicalizePath files             putStrLn $ "Found " ++ show (length absoluteFiles) ++ " files"@@ -445,16 +449,45 @@             registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)             c ide -expandFiles :: [FilePath] -> IO [FilePath]-expandFiles = concatMapM $ \x -> do+-- | List the haskell files given some paths+--+-- It will rely on git if possible to filter-out ignored files.+expandFiles :: Recorder (WithPriority Log) -> [FilePath] -> IO [FilePath]+expandFiles recorder paths = do+  let haskellFind x =+        let recurse "." = True+            recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc+            recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories+        in filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x+      git args = do+        mResult <- (Just <$> readProcessWithExitCode "git" args "") `Safe.catchAny`const (pure Nothing)+        pure $+            case mResult of+              Just (ExitSuccess, gitStdout, _) -> Just gitStdout+              _                                -> Nothing+  mHasGit <- git ["status"]+  when (isJust mHasGit) $ logWith recorder Info LogUsingGit+  let findFiles =+        case mHasGit of+          Just _ -> \path -> do+            let lookups =+                  if takeExtension path `elem` [".hs", ".lhs"]+                      then [path]+                      else [path </> "*.hs", path </> "*.lhs"]+                gitLines args = fmap lines <$> git args+            mTracked <- gitLines ("ls-files":lookups)+            mUntracked <- gitLines ("ls-files":"-o":lookups)+            case mTracked <> mUntracked of+              Nothing    -> haskellFind path+              Just files -> pure files+          _ -> haskellFind++  flip concatMapM paths $ \x -> do     b <- IO.doesFileExist x     if b         then return [x]         else do-            let recurse "." = True-                recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc-                recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories-            files <- filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x+            files <- findFiles x             when (null files) $                 fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x             return files

@@ -69,6 +69,7 @@ import           Development.IDE.Spans.AtPoint            (pointCommand)  +import qualified Development.IDE.Plugin.Completions.Types as C import           GHC.Plugins                              (Depth (AllTheWay),                                                            mkUserStyle,                                                            neverQualify,@@ -202,7 +203,7 @@                   _preselect = Nothing,                   _sortText = Nothing,                   _filterText = Nothing,-                  _insertText = Just insertText,+                  _insertText = Just $ snippetToText insertText,                   _insertTextFormat = Just InsertTextFormat_Snippet,                   _insertTextMode = Nothing,                   _textEdit = Nothing,@@ -242,10 +243,9 @@     isTypeCompl = isTcOcc origName     typeText = Nothing     label = stripOccNamePrefix $ printOutputable origName-    insertText = case isInfix of+    insertText = snippetText $ case isInfix of             Nothing         -> label             Just LeftSide   -> label <> "`"-             Just Surrounded -> label     additionalTextEdits =       imp <&> \x ->@@ -294,7 +294,7 @@ fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem fromIdentInfo doc identInfo@IdentInfo{..} q = CI   { compKind= occNameToComKind name-  , insertText=rend+  , insertText= snippetText rend   , provenance = DefinedIn mod   , label=rend   , typeText = Nothing@@ -458,10 +458,11 @@         ]      mkLocalComp pos n ctyp ty =-        CI ctyp pn (Local pos) pn ty Nothing (ctyp `elem` [CompletionItemKind_Struct, CompletionItemKind_Interface]) Nothing (Just $ NameDetails (ms_mod $ pm_mod_summary pm) occ) True+        CI ctyp sn (Local pos) pn ty Nothing (ctyp `elem` [CompletionItemKind_Struct, CompletionItemKind_Interface]) Nothing (Just $ NameDetails (ms_mod $ pm_mod_summary pm) occ) True       where         occ = rdrNameOcc $ unLoc n         pn = showForSnippet n+        sn = snippetText pn  findRecordCompl :: Uri -> Provenance -> TyClDecl GhcPs -> [CompItem] findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result@@ -489,10 +490,17 @@             --             -- is encoded as @[[arg1, arg2], [arg3], [arg4]]@             -- Hence, we must concat nested arguments into one to get all the fields.+#if MIN_VERSION_ghc(9,13,0)+        extract HsConDeclRecField{..}+            = map (foLabel . unLoc) cdrf_names+        -- XConDeclRecField+        extract _ = []+#else         extract ConDeclField{..}             = map (foLabel . unLoc) cd_fld_names         -- XConDeclField         extract _ = []+#endif findRecordCompl _ _ _ = []  toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem@@ -638,7 +646,7 @@               dotFieldSelectorToCompl :: T.Text -> T.Text -> (Bool, CompItem)               dotFieldSelectorToCompl recname label = (True, CI                 { compKind = CompletionItemKind_Field-                , insertText = label+                , insertText = snippetText label                 , provenance = DefinedIn recname                 , label = label                 , typeText = Nothing@@ -667,7 +675,7 @@           endLoc = upperRange oldPos           localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc           localBindsToCompItem :: Name -> Maybe Type -> CompItem-          localBindsToCompItem name typ = CI ctyp pn thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True+          localBindsToCompItem name typ = CI ctyp (snippetText pn) thisModName pn ty Nothing (not $ isValOcc occ) Nothing dets True             where               occ = nameOccName name               ctyp = occNameToComKind occ@@ -736,7 +744,8 @@         -- filter global completions when we already have a local one         || not(isLocalCompletion candidate) && isLocalCompletion unique         then EQ-        else compare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique)+        else compare (importedFrom candidate) (importedFrom unique) <>+             snippetLexOrd (insertText candidate) (insertText unique)     other -> other   where       importedFrom :: CompItem -> T.Text@@ -805,9 +814,10 @@           }        placeholder_pairs = zip compl ([1..]::[Int])-      snippet_parts = map (\(x, i) -> x <> "=${" <> T.pack (show i) <> ":_" <> x <> "}") placeholder_pairs-      snippet = T.intercalate (T.pack ", ") snippet_parts-      buildSnippet = ctxStr <> " {" <> snippet <> "}"+      snippet_parts = placeholder_pairs <&> \(x, i) ->+        snippetText x <> "=" <> snippetVariableDefault (T.pack $ show i) (C.SText $ "_" <> x)+      snippet = mconcat $ intersperse ", " snippet_parts+      buildSnippet = snippetText ctxStr <> " {" <> snippet <> "}"  getImportQual :: LImportDecl GhcPs -> Maybe T.Text getImportQual (L _ imp)

@@ -14,7 +14,11 @@  import           Data.Aeson import           Data.Aeson.Types+import           Data.Function                (on) import           Data.Hashable                (Hashable)+import qualified Data.List                    as L+import           Data.List.NonEmpty           (NonEmpty (..))+import           Data.String                  (IsString (..)) import           Data.Text                    (Text) import           Development.IDE.GHC.Compat import           Development.IDE.Graph        (RuleResult)@@ -81,9 +85,60 @@     | Local SrcSpan     deriving (Eq, Ord, Show) +newtype Snippet = Snippet [SnippetAny]+  deriving (Eq, Show)+  deriving newtype (Semigroup, Monoid)++instance IsString Snippet where+  fromString = snippetText . T.pack++-- | @SnippetAny@ can be used to construct sanitized snippets. See the LSP+-- spec for more details.+data SnippetAny+  = SText Text+  -- ^ Literal text+  | STabStop Int (Maybe SnippetAny)+  -- ^ Creates a tab stop, i.e. parts of the snippet that are meant to be+  -- filled in by the user and that can be jumped between using the tab key.+  -- The optional field can be used to provide a placeholder value.+  | SChoice Int (NonEmpty Text)+  -- ^ Presents a choice between the provided values to the user+  | SVariable Text (Maybe SnippetAny)+  -- ^ Snippet variable. See the spec for possible values. The optional field+  -- can be used to provide a default value for when the variable is not set.+  deriving (Eq, Show)++snippetText :: Text -> Snippet+snippetText = Snippet . L.singleton . SText++snippetVariable :: Text -> Snippet+snippetVariable n = Snippet . L.singleton $ SVariable n Nothing++snippetVariableDefault :: Text -> SnippetAny -> Snippet+snippetVariableDefault n d = Snippet . L.singleton . SVariable n $ Just d++snippetToText :: Snippet -> Text+snippetToText (Snippet l) = foldMap (snippetAnyToText False) l+  where+    snippetAnyToText isNested = \case+      SText t -> sanitizeText isNested t+      STabStop i ph -> "${" <> T.pack (show i) <> foldMap (\p -> ":" <> snippetAnyToText True p) ph <> "}"+      SChoice i (c :| cs) -> "${" <> T.pack (show i) <> "|" <> c <> foldMap ("," <>) cs <> "}"+      SVariable n md -> "${" <> n <> foldMap (\x -> ":" <> snippetAnyToText True x) md <> "}"+    sanitizeText isNested = T.foldl' (sanitizeChar isNested) mempty+    sanitizeChar isNested t = (t <>) . \case+      '$' -> "\\$"+      '\\' -> "\\\\"+      ',' | isNested -> "\\,"+      '|' | isNested -> "\\|"+      c -> T.singleton c++snippetLexOrd :: Snippet -> Snippet -> Ordering+snippetLexOrd = compare `on` snippetToText+ data CompItem = CI   { compKind            :: CompletionItemKind-  , insertText          :: T.Text         -- ^ Snippet for the completion+  , insertText          :: Snippet        -- ^ Snippet for the completion   , provenance          :: Provenance     -- ^ From where this item is imported from.   , label               :: T.Text         -- ^ Label to display to the user.   , typeText            :: Maybe T.Text

@@ -57,6 +57,7 @@ import           Development.IDE.Graph.Classes import           Development.IDE.Types.Location       (Position (Position, _line),                                                        Range (Range, _end, _start))+import           GHC.Core.TyCo.Tidy                   (tidyOpenType) import           GHC.Generics                         (Generic) import           Ide.Logger                           (Pretty (pretty),                                                        Recorder, WithPriority,

@@ -45,7 +45,6 @@ import           Development.IDE.Spans.Common import           Development.IDE.Types.Options -import           Control.Applicative import           Control.Monad.Extra import           Control.Monad.IO.Class import           Control.Monad.Trans.Class@@ -61,17 +60,25 @@ import           Data.List.Extra                      (dropEnd1, nubOrd)  +import           Control.Lens                         ((^.)) import           Data.Either.Extra                    (eitherToMaybe) import           Data.List                            (isSuffixOf, sortOn)+import           Data.Set                             (Set)+import qualified Data.Set                             as S import           Data.Tree import qualified Data.Tree                            as T import           Data.Version                         (showVersion)+import           Development.IDE.Core.LookupMod       (LookupModule, lookupMod)+import           Development.IDE.Core.Shake           (ShakeExtras (..),+                                                       runIdeAction) import           Development.IDE.Types.Shake          (WithHieDb) import           GHC.Iface.Ext.Types                  (EvVarSource (..),                                                        HieAST (..),                                                        HieASTs (..),                                                        HieArgs (..),-                                                       HieType (..), Identifier,+                                                       HieType (..),+                                                       HieTypeFix (..),+                                                       Identifier,                                                        IdentifierDetails (..),                                                        NodeInfo (..), Scope,                                                        Span)@@ -86,12 +93,9 @@                                                        selectSmallestContaining) import           HieDb                                hiding (pointCommand,                                                        withHieDb)+import qualified Language.LSP.Protocol.Lens           as L import           System.Directory                     (doesFileExist) --- | Gives a Uri for the module, given the .hie file location and the the module info--- The Bool denotes if it is a boot module-type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri- -- | HieFileResult for files of interest, along with the position mappings newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping)) @@ -251,31 +255,41 @@ -- | Synopsis for the name at a given position. atPoint   :: IdeOptions+  -> ShakeExtras   -> HieAstResult   -> DocAndTyThingMap   -> HscEnv   -> Position   -> IO (Maybe (Maybe Range, [T.Text]))-atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos =+atPoint opts@IdeOptions{} shakeExtras@ShakeExtras{ withHieDb, hiedbWriter } har@(HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos =     listToMaybe <$> sequence (pointCommand hf pos hoverInfo)   where     -- Hover info for values/data     hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text])     hoverInfo ast = do-        prettyNames <- mapM prettyName names-        pure (Just range, prettyNames ++ pTypes)+        locationsWithIdentifier <- runIdeAction "TypeCheck" shakeExtras $ do+          runMaybeT $ gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts har pos++        let locationsMap = M.fromList $ mapMaybe (\(loc, identifier) -> case identifier of+              Right typeName ->+                -- Filter out type variables (polymorphic names like 'a', 'b', etc.)+                if isTyVarName typeName+                  then Nothing+                  else Just (typeName, loc)+              Left _moduleName -> Nothing) $ fromMaybe [] locationsWithIdentifier++        prettyNames <- mapM (prettyName locationsMap) names+        pure (Just range, prettyNames ++ pTypes locationsMap)       where-        pTypes :: [T.Text]-        pTypes-          | Prelude.length names == 1 = dropEnd1 $ map wrapHaskell prettyTypes-          | otherwise = map wrapHaskell prettyTypes+        pTypes :: M.Map Name Location -> [T.Text]+        pTypes locationsMap =+          case names of+            [_singleName] -> dropEnd1 $ prettyTypes Nothing locationsMap+            _             -> prettyTypes Nothing locationsMap          range :: Range         range = realSrcSpanToRange $ nodeSpan ast -        wrapHaskell :: T.Text -> T.Text-        wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"-         info :: NodeInfo hietype         info = nodeInfoH kind ast @@ -284,8 +298,8 @@         names :: [(Identifier, IdentifierDetails hietype)]         names = sortOn (any isEvidenceUse . identInfo . snd) $ M.assocs $ nodeIdentifiers info -        prettyName :: (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text-        prettyName (Right n, dets)+        prettyName :: M.Map Name Location -> (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text+        prettyName locationsMap (Right n, dets)           -- We want to print evidence variable using a readable tree structure.           -- Evidence variables contain information why a particular instance or           -- type equality was chosen, paired with location information.@@ -299,20 +313,23 @@               pure $ evidenceTree <> "\n"           -- Identifier details that are not evidence variables are used to display type information and           -- documentation of that name.-          | otherwise =+          | otherwise = do             let-              typeSig = wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))+              typeSig = case identType dets of+                Just t -> prettyType (Just n) locationsMap t+                Nothing -> case safeTyThingType =<< lookupNameEnv km n of+                  Just kind -> prettyTypeFromType (Just n) locationsMap kind+                  Nothing   -> wrapHaskell (printOutputable n)               definitionLoc = maybeToList (pretty (definedAt n) (prettyPackageName n))               docs = maybeToList (T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n)-            in-              pure $ T.unlines $-                [typeSig] ++ definitionLoc ++ docs-          where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n++            pure $ T.unlines $ [typeSig] ++ definitionLoc ++ docs+          where                 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,_) = packageNameForImportStatement m+        prettyName _locationsMap (Left m,_) = packageNameForImportStatement m          prettyPackageName :: Name -> Maybe T.Text         prettyPackageName n = do@@ -343,14 +360,69 @@         -- Type info for the current node, it may contain several symbols         -- for one range, like wildcard         types :: [hietype]-        types = nodeType info+        types = take maxHoverTypes $ nodeType info -        prettyTypes :: [T.Text]-        prettyTypes = map (("_ :: "<>) . prettyType) types+        maxHoverTypes :: Int+        maxHoverTypes = 10 -        prettyType :: hietype -> T.Text-        prettyType = printOutputable . expandType+        prettyTypes :: Maybe Name -> M.Map Name Location -> [T.Text]+        prettyTypes boundNameMay locationsMap =+          map (prettyType boundNameMay locationsMap) types +        prettyTypeFromType :: Maybe Name -> M.Map Name Location -> Type -> T.Text+        prettyTypeFromType boundNameMay locationsMap ty =+          prettyTypeCommon boundNameMay locationsMap (S.fromList $ namesInType ty) (printOutputable ty)++        prettyType :: Maybe Name -> M.Map Name Location -> hietype -> T.Text+        prettyType boundNameMay locationsMap t =+          prettyTypeCommon boundNameMay locationsMap (typeNames t) (printOutputable . expandType $ t)++        prettyTypeCommon :: Maybe Name -> M.Map Name Location -> Set Name -> T.Text -> T.Text+        prettyTypeCommon boundNameMay locationsMap names expandedType =+          let nameToUse = case boundNameMay of+                Just n  -> printOutputable n+                Nothing -> "_"+              expandedWithName = nameToUse <> " :: " <> expandedType+              codeBlock = wrapHaskell expandedWithName+              links = case boundNameMay of+                Just _  -> generateLinksList locationsMap names+                -- This is so we don't get flooded with links, e.g:+                -- foo :: forall a. MyType a -> a+                -- Go to MyType+                -- _ :: forall a. MyType a -> a+                -- Go to MyType -- <- we don't want this as it's already present+                Nothing -> ""+          in codeBlock <> links++        generateLinksList :: M.Map Name Location -> Set Name -> T.Text+        generateLinksList locationsMap (S.toList -> names) =+          if null generated+            then ""+            else "\n" <> "Go to " <> T.intercalate " | " generated <> "\n"+          where+            generated = mapMaybe generateLink names++            generateLink name = do+              case M.lookup name locationsMap of+                Just (Location uri range) ->+                  let nameText = printOutputable name+                      link = "[" <> nameText <> "](" <> getUriText uri <> "#L" <>+                             T.pack (show (range ^. L.start . L.line + 1)) <> ")"+                  in Just link+                Nothing -> Nothing++        wrapHaskell :: T.Text -> T.Text+        wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"++        getUriText :: Uri -> T.Text+        getUriText (Uri t) = t++        typeNames :: a -> Set Name+        typeNames t = S.fromList $ case kind of+          HieFresh -> namesInType t+          HieFromDisk full_file -> do+            namesInHieTypeFix $ recoverFullType t (hie_types full_file)+         expandType :: a -> SDoc         expandType t = case kind of           HieFresh -> ppr t@@ -468,8 +540,23 @@ namesInType (LitTy _)        = [] namesInType _                = [] + getTypes :: [Type] -> [Name] getTypes = concatMap namesInType++namesInHieTypeFix :: HieTypeFix -> [Name]+namesInHieTypeFix (Roll hieType) = namesInHieType hieType++namesInHieType :: HieType HieTypeFix -> [Name]+namesInHieType (HTyVarTy n)         = [n]+namesInHieType (HAppTy a (HieArgs args)) = namesInHieTypeFix a ++ concatMap (namesInHieTypeFix . snd) args+namesInHieType (HTyConApp tc (HieArgs args)) = ifaceTyConName tc : concatMap (namesInHieTypeFix . snd) args+namesInHieType (HForAllTy ((binder, constraint), _) body) = binder : namesInHieTypeFix constraint ++ namesInHieTypeFix body+namesInHieType (HFunTy mult arg res) = namesInHieTypeFix mult ++ namesInHieTypeFix arg ++ namesInHieTypeFix res+namesInHieType (HQualTy constraint body) = namesInHieTypeFix constraint ++ namesInHieTypeFix body+namesInHieType (HLitTy _)           = []+namesInHieType (HCastTy a)          = namesInHieTypeFix a+namesInHieType HCoercionTy          = []  -- | Find 'Location's of definition at a specific point and return them along with their 'Identifier's. locationsAtPoint

@@ -61,11 +61,19 @@     let hscEnv = hscEnv'                { hsc_FC = FinderCache                         { flushFinderCaches = \_ -> error "GHC should never call flushFinderCaches outside the driver"+#if MIN_VERSION_ghc(9,13,0)+                        , addToFinderCache  = \im val -> do+#else                         , addToFinderCache  = \(GWIB im _) val -> do+#endif                             if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv'                             then error "tried to add home module to FC"                             else atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleEnv c im val, ())+#if MIN_VERSION_ghc(9,13,0)+                        , lookupFinderCache = \im -> do+#else                         , lookupFinderCache = \(GWIB im _) -> do+#endif                             if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv'                             then error ("tried to lookup home module from FC" ++ showSDocUnsafe (ppr (im, hsc_all_home_unit_ids hscEnv')))                             else lookupInstalledModuleEnv <$> readIORef mod_cache <*> pure im

@@ -0,0 +1,16 @@+module Text.Fuzzy.Levenshtein where++import           Data.List           (sortOn)+import           Data.Text           (Text)+import qualified Data.Text           as T+import           Text.EditDistance+import           Text.Fuzzy.Parallel++-- | Sort the given list according to it's levenshtein distance relative to the+-- given string.+levenshteinScored :: Int -> Text -> [Text] -> [Scored Text]+levenshteinScored chunkSize needle haystack = do+  let levenshtein = levenshteinDistance $ defaultEditCosts {substitutionCosts=ConstantCost 2}+  sortOn score $+    matchPar chunkSize needle haystack id $+      \a b -> Just $ levenshtein (T.unpack a) (T.unpack b)

@@ -1,7 +1,7 @@ -- | Parallel versions of 'filter' and 'simpleFilter'  module Text.Fuzzy.Parallel-(   filter, filter',+(   filter, filter', matchPar,     simpleFilter, simpleFilter',     match, defChunkSize, defMaxResults,     Scored(..)@@ -103,15 +103,29 @@        -- ^ Custom scoring function to use for calculating how close words are        -- When the function returns Nothing, this means the values are incomparable.        -> [Scored t]    -- ^ The list of results, sorted, highest score first.-filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore (concat vss)+filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore $+    matchPar chunkSize pat' ts extract match'   where-      -- Preserve case for the first character, make all others lowercase-      pat' = case T.uncons pat of+    perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat pat+    -- Preserve case for the first character, make all others lowercase+    pat' = case T.uncons pat of         Just (c, rest) -> T.cons c (T.toLower rest)         _              -> pat-      vss = map (mapMaybe (\t -> flip Scored t <$> match' pat' (extract t))) (chunkList chunkSize ts)++matchPar+    :: Int           -- ^ Chunk size. 1000 works well.+    -> T.Text        -- ^ Pattern.+    -> [t]           -- ^ The list of values containing the text to search in.+    -> (t -> T.Text) -- ^ The function to extract the text from the container.+    -> (T.Text -> T.Text -> Maybe Int)+    -- ^ Custom scoring function to use for calculating how close words are+    -- When the function returns Nothing, this means the values are incomparable.+    -> [Scored t]    -- ^ The list of results, sorted, highest score first.+{-# INLINABLE matchPar #-}+matchPar chunkSize pat ts extract match' = concat vss+  where+    vss = map (mapMaybe (\t -> flip Scored t <$> match' pat (extract t))) (chunkList chunkSize ts)         `using` parList (evalList rseq)-      perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat' pat'  -- | The function to filter a list of values by fuzzy search on the text extracted from them, -- using a custom matching function which determines how close words are.