diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index eec9388917..bc3234fde6 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -26,12 +26,12 @@ runs: - name: Workaround runner image issue if: runner.os == 'Linux' # https://github.com/actions/runner-images/issues/7061 - run: | + run: | sudo mkdir -p /usr/local/.ghcup sudo chown -R $USER /usr/local/.ghcup shell: bash - - uses: haskell/actions/setup@v2.3.5 + - uses: haskell/actions/setup@v2.3.6 id: HaskEnvSetup with: ghc-version : ${{ inputs.ghc }} diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index e86bbcb8e7..21224269b6 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -57,6 +57,14 @@ jobs: steps: - uses: actions/checkout@v3 + with: + + # By default, the `pull_request` event has a `GITHUB_SHA` env variable + # set to the "last merge commit on the GITHUB_REF branch" (see + # https://docs.github.com/en/actions/using-workflows/events-that-trigger-workflows#pull_request). + # But we want to check out the latest commit on the branch whether or + # not it is a merge commit, so this is how we do that. + ref: "${{ github.event.pull_request.head.sha }}" - run: git fetch origin master # check the master branch for benchmarking diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index f9cde8910e..c23d777dcd 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -55,6 +55,14 @@ jobs: steps: - uses: actions/checkout@v3 + with: + + # By default, the `pull_request` event has a `GITHUB_SHA` env variable + # set to the "last merge commit on the GITHUB_REF branch" (see + # https://docs.github.com/en/actions/using-workflows/events-that-trigger-workflows#pull_request). + # But we want to check out the latest commit on the branch whether or + # not it is a merge commit, so this is how we do that. + ref: "${{ github.event.pull_request.head.sha }}" - uses: ./.github/actions/setup-build with: diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index c4daf31fea..c37b4ae59b 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -103,7 +103,7 @@ jobs: # We only build nix dev shell for current GHC version because some are # failing with different GHC version on darwin. - name: Build development shell with nix dependencies for current GHC version - run: nix develop --print-build-logs .#haskell-language-server-dev-nix --profile dev + run: nix develop --print-build-logs .#all-nix-dev-shells --profile dev - name: Push development shell if: ${{ env.HAS_TOKEN == 'true' }} run: cachix push haskell-language-server dev diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index bee88eb5a7..9457d7d7bd 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -[ "9.4.4" , "9.2.5" , "9.0.2" , "8.10.7" ] +[ "9.6.1", "9.4.4" , "9.2.5" , "9.0.2" , "8.10.7" ] diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index a9313b3938..c818236356 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -136,7 +136,7 @@ jobs: name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refactor-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.6.1' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" @@ -152,7 +152,7 @@ jobs: name: Test hls-eval-plugin run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' + - if: matrix.test && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' && matrix.ghc != '9.6.1' name: Test hls-haddock-comments-plugin run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" @@ -160,19 +160,19 @@ jobs: name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.6.1' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.6.1' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.6.1' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' + - if: matrix.test && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' && matrix.ghc != '9.6.1' name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" @@ -192,11 +192,11 @@ jobs: name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.6.1' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.0.2' && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' + - if: matrix.test && matrix.ghc != '9.0.2' && matrix.ghc != '9.2.5' && matrix.ghc != '9.4.4' && matrix.ghc != '9.6.1' name: Test hls-stan-plugin test suite run: cabal test hls-stan-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stan-plugin --test-options="$TEST_OPTS" diff --git a/cabal.project b/cabal.project index 6ce3c45205..e535b882ae 100644 --- a/cabal.project +++ b/cabal.project @@ -42,7 +42,18 @@ packages: -- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml optional-packages: vendored/*/*.cabal -tests: true +tests: True + +-- mfsolve has duplicate instances in its test suite +-- See: https://github.com/kuribas/mfsolve/issues/8 +package mfsolve + tests: False + +if impl(ghc >= 9.5) + source-repository-package + type:git + location: https://github.com/wz1000/retrie + tag: 0a2dbfc00e745737f249f16325b2815d2e3a14eb package * ghc-options: -haddock @@ -50,7 +61,7 @@ package * write-ghc-environment-files: never -index-state: 2023-03-15T00:00:00Z +index-state: 2023-03-23T00:00:00Z constraints: -- For GHC 9.4, older versions of entropy fail to build on Windows @@ -67,8 +78,9 @@ constraints: ghc-lib-parser-ex -auto, stylish-haskell +ghc-lib, fourmolu -fixity-th, - -- http2 doesn't build with -haddock on ghc-8.10 - http2 < 4.0.0 + setup.happy == 1.20.1.1, + happy == 1.20.1.1, + filepath installed, -- This is benign and won't affect our ability to release to Hackage, -- because we only depend on `ekg-json` when a non-default flag @@ -81,7 +93,6 @@ source-repository-package type:git location: https://github.com/pepeiborra/ekg-json tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460 - -- https://github.com/tibbe/ekg-json/pull/12 -- END DELETE allow-newer: @@ -107,3 +118,23 @@ allow-newer: uuid:time, vector-space:base, ekg-wai:time, + +if impl(ghc >= 9.5) + allow-newer: + -- ghc-9.6 + algebraic-graphs:transformers, + cryptohash-md5:base, + cryptohash-sha1:base, + ekg-core:ghc-prim, + focus:transformers, + ghc-trace-events:base, + implicit-hie-cradle:transformers, + retrie:base, + retrie:ghc, + retrie:ghc-exactprint, + retrie:mtl, + retrie:transformers, + semigroupoids:base, + stm-hamt:transformers, + entropy:Cabal, + diff --git a/configuration-ghc-96.nix b/configuration-ghc-96.nix new file mode 100644 index 0000000000..1ad169ed03 --- /dev/null +++ b/configuration-ghc-96.nix @@ -0,0 +1,58 @@ +{ pkgs, inputs }: + +let + disabledPlugins = [ + # That one is not technically a plugin, but by putting it in this list, we + # get it removed from the top level list of requirement and it is not pull + # in the nix shell. + "shake-bench" + "hls-retrie-plugin" + "hls-splice-plugin" + "hls-class-plugin" + "hls-rename-plugin" + "hls-gadt-plugin" + "hls-refactor-plugin" + ]; + + hpkgsOverride = hself: hsuper: + with pkgs.haskell.lib; + { + hlsDisabledPlugins = disabledPlugins; + + # Override for all derivation + # If they are considered as broken, we just disable jailbreak and hope for the best + mkDerivation = args: + hsuper.mkDerivation (args // + { + jailbreak = true; + broken = false; + doCheck = false; + }); + apply-refact = hsuper.apply-refact_0_12_0_0; + tagged = hself.callHackage "tagged" "0.8.7" { }; + primitive = hself.callHackage "primitive" "0.8.0.0" { }; + unix-compat = hself.callCabal2nix "unix-compat" inputs.haskell-unix-compat { }; + MonadRandom = hself.callHackage "MonadRandom" "0.6" { }; + hiedb = hself.callCabal2nix "hiedb" inputs.haskell-hiedb { }; + hie-bios = hself.callCabal2nix "hie-bios" inputs.haskell-hie-bios { }; + ghc-exactprint = hself.callCabal2nix "ghc-exactprint" inputs.haskell-ghc-exactprint { }; + + # ptr-poker breaks on MacOS without SSE2 optimizations + # https://github.com/nikita-volkov/ptr-poker/issues/11 + ptr-poker = hself.callCabal2nix "ptr-poker" inputs.ptr-poker { }; + + ormolu = hself.ormolu_0_5_3_0; + + stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-fghc-lib"; + + # Re-generate HLS drv excluding some plugins + haskell-language-server = + hself.callCabal2nixWithOptions "haskell-language-server" ./. + # Pedantic cannot be used due to -Werror=unused-top-binds + # Check must be disabled due to some missing required files + (pkgs.lib.concatStringsSep " " [ "--no-check" "-f-pedantic" "-f-hlint" "-f-refactor" "-f-retrie" "-f-class" "-f-gadt" "-f-splice" "-f-rename" ]) { }; + }; +in { + inherit disabledPlugins; + tweakHpkgs = hpkgs: hpkgs.extend hpkgsOverride; +} diff --git a/flake.lock b/flake.lock index 03d3a861eb..b0468e4713 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1668681692, - "narHash": "sha256-Ht91NGdewz8IQLtWZ9LCeNXMSXHUss+9COoqu6JLmXU=", + "lastModified": 1673956053, + "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=", "owner": "edolstra", "repo": "flake-compat", - "rev": "009399224d5e398d03b22badca40a37ac85412a1", + "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9", "type": "github" }, "original": { @@ -18,11 +18,11 @@ }, "flake-utils": { "locked": { - "lastModified": 1667395993, - "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "lastModified": 1678901627, + "narHash": "sha256-U02riOqrKKzwjsxc/400XnElV+UtPUQWpANPlyazjH0=", "owner": "numtide", "repo": "flake-utils", - "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "rev": "93a2b84fc4b70d9e089d029deacc3583435c2ed6", "type": "github" }, "original": { @@ -59,6 +59,72 @@ "type": "github" } }, + "haskell-ghc-exactprint": { + "flake": false, + "locked": { + "lastModified": 1678824759, + "narHash": "sha256-2I+GyVrfevo/vWZqIdXZ+Cg0+cU/755M0GhaSHiiZCQ=", + "owner": "alanz", + "repo": "ghc-exactprint", + "rev": "db5e8ab3817c9ee34e37359d5839e9526e05e448", + "type": "github" + }, + "original": { + "owner": "alanz", + "ref": "ghc-9.6", + "repo": "ghc-exactprint", + "type": "github" + } + }, + "haskell-hie-bios": { + "flake": false, + "locked": { + "lastModified": 1679040151, + "narHash": "sha256-1Y/9wCoR+nMvSrEr0EHnRBCkUuhqWPgPuukNM5zzRT8=", + "owner": "mpickering", + "repo": "hie-bios", + "rev": "af192d4116a382afa1721a6f8d77729f98993082", + "type": "github" + }, + "original": { + "owner": "mpickering", + "repo": "hie-bios", + "type": "github" + } + }, + "haskell-hiedb": { + "flake": false, + "locked": { + "lastModified": 1678673879, + "narHash": "sha256-KN/adLZuREPcZ1fEHCuxF/WjGmTE2nSnlW1vCp+aJL0=", + "owner": "wz1000", + "repo": "HieDb", + "rev": "d4e12eb22c7d832ad54c2e4c433217028fe95c83", + "type": "github" + }, + "original": { + "owner": "wz1000", + "repo": "HieDb", + "type": "github" + } + }, + "haskell-unix-compat": { + "flake": false, + "locked": { + "lastModified": 1664758053, + "narHash": "sha256-JD/EPdPYEOfS6WqGXOZrdcRUiVkHInSwZT8hn/iQmLs=", + "owner": "jacobstanley", + "repo": "unix-compat", + "rev": "3f6bd688cb56224955e77245a2649ba99ea32fff", + "type": "github" + }, + "original": { + "owner": "jacobstanley", + "repo": "unix-compat", + "rev": "3f6bd688cb56224955e77245a2649ba99ea32fff", + "type": "github" + } + }, "hlint-35": { "flake": false, "locked": { @@ -73,16 +139,16 @@ }, "nixpkgs": { "locked": { - "lastModified": 1678987615, - "narHash": "sha256-lF4agoB7ysQGNHRXvOqxtSKIZrUZwClA85aASahQlYM=", + "lastModified": 1679011989, + "narHash": "sha256-TTyzL8k0ZY2otX8xcvi+GAbFD3dpFVg5UJkgmpJBuuA=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "194c2aa446b2b059886bb68be15ef6736d5a8c31", + "rev": "aae97499619fdf720c9524168d831cae04ceae5a", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", + "ref": "haskell-updates", "repo": "nixpkgs", "type": "github" } @@ -117,6 +183,10 @@ "flake-utils": "flake-utils", "ghc-lib-parser-94": "ghc-lib-parser-94", "gitignore": "gitignore", + "haskell-ghc-exactprint": "haskell-ghc-exactprint", + "haskell-hie-bios": "haskell-hie-bios", + "haskell-hiedb": "haskell-hiedb", + "haskell-unix-compat": "haskell-unix-compat", "hlint-35": "hlint-35", "nixpkgs": "nixpkgs", "ormolu-052": "ormolu-052", diff --git a/flake.nix b/flake.nix index 938a1c5b7f..6ef619baf4 100644 --- a/flake.nix +++ b/flake.nix @@ -8,7 +8,7 @@ description = "haskell language server flake"; inputs = { - nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; + nixpkgs.url = "github:NixOS/nixpkgs/haskell-updates"; flake-compat = { url = "github:edolstra/flake-compat"; flake = false; @@ -40,6 +40,25 @@ url = "https://hackage.haskell.org/package/stylish-haskell-0.14.4.0/stylish-haskell-0.14.4.0.tar.gz"; flake = false; }; + + haskell-unix-compat = { + url = "github:jacobstanley/unix-compat/3f6bd688cb56224955e77245a2649ba99ea32fff"; + flake = false; + }; + haskell-hiedb = { + url = "github:wz1000/HieDb"; + flake = false; + }; + + haskell-hie-bios = { + url = "github:mpickering/hie-bios"; + flake = false; + }; + + haskell-ghc-exactprint = { + url = "github:alanz/ghc-exactprint/ghc-9.6"; + flake = false; + }; }; outputs = inputs@{ self, nixpkgs, flake-compat, flake-utils, gitignore, ... }: @@ -172,8 +191,9 @@ }; ghc902Config = (import ./configuration-ghc-90.nix) { inherit pkgs inputs; }; - ghc927Config = (import ./configuration-ghc-92.nix) { inherit pkgs inputs; }; + ghc926Config = (import ./configuration-ghc-92.nix) { inherit pkgs inputs; }; ghc944Config = (import ./configuration-ghc-94.nix) { inherit pkgs inputs; }; + ghc961Config = (import ./configuration-ghc-96.nix) { inherit pkgs inputs; }; # GHC versions # While HLS still works fine with 8.10 GHCs, we only support the versions that are cached @@ -182,14 +202,16 @@ ghcVersion = "ghc" + (pkgs.lib.replaceStrings ["."] [""] pkgs.haskellPackages.ghc.version); cases = { ghc902 = ghc902Config.tweakHpkgs (pkgs.hlsHpkgs "ghc902"); - ghc927 = ghc927Config.tweakHpkgs (pkgs.hlsHpkgs "ghc927"); + ghc926 = ghc926Config.tweakHpkgs (pkgs.hlsHpkgs "ghc926"); ghc944 = ghc944Config.tweakHpkgs (pkgs.hlsHpkgs "ghc944"); + ghc961 = ghc961Config.tweakHpkgs (pkgs.hlsHpkgs "ghc961"); }; in { default = cases."${ghcVersion}"; } // cases; ghc902 = supportedGHCs.ghc902; - ghc927 = supportedGHCs.ghc927; + ghc926 = supportedGHCs.ghc926; ghc944 = supportedGHCs.ghc944; + ghc961 = supportedGHCs.ghc961; ghcDefault = supportedGHCs.default; pythonWithPackages = pkgs.python3.withPackages (ps: [ps.sphinx ps.myst-parser ps.sphinx_rtd_theme ps.pip]); @@ -310,16 +332,18 @@ simpleDevShells = { haskell-language-server-dev = mkDevShell ghcDefault "cabal.project"; haskell-language-server-902-dev = mkDevShell ghc902 "cabal.project"; - haskell-language-server-927-dev = mkDevShell ghc927 "cabal.project"; + haskell-language-server-926-dev = mkDevShell ghc926 "cabal.project"; haskell-language-server-944-dev = mkDevShell ghc944 "cabal.project"; + haskell-language-server-961-dev = mkDevShell ghc961 "cabal.project"; }; # Developement shell, haskell packages are also provided by nix nixDevShells = { haskell-language-server-dev-nix = mkDevShellWithNixDeps ghcDefault "cabal.project"; haskell-language-server-902-dev-nix = mkDevShellWithNixDeps ghc902 "cabal.project"; - haskell-language-server-927-dev-nix = mkDevShellWithNixDeps ghc927 "cabal.project"; + haskell-language-server-926-dev-nix = mkDevShellWithNixDeps ghc926 "cabal.project"; haskell-language-server-944-dev-nix = mkDevShellWithNixDeps ghc944 "cabal.project"; + haskell-language-server-961-dev-nix = mkDevShellWithNixDeps ghc961 "cabal.project"; }; # The default shell provided by Nixpkgs for a Haskell package (i.e. the @@ -327,15 +351,17 @@ envShells = { haskell-language-server-dev-env = mkEnvShell ghcDefault; haskell-language-server-902-dev-env = mkEnvShell ghc902; - haskell-language-server-927-dev-env = mkEnvShell ghc927; + haskell-language-server-926-dev-env = mkEnvShell ghc926; haskell-language-server-944-dev-env = mkEnvShell ghc944; + haskell-language-server-961-dev-env = mkEnvShell ghc961; }; allPackages = { haskell-language-server = mkExe ghcDefault; haskell-language-server-902 = mkExe ghc902; - haskell-language-server-927 = mkExe ghc927; + haskell-language-server-926 = mkExe ghc926; haskell-language-server-944 = mkExe ghc944; + haskell-language-server-961 = mkExe ghc961; }; devShells = simpleDevShells // nixDevShells // envShells // { @@ -354,8 +380,9 @@ all-haskell-language-server = linkFarmFromDrvs "all-haskell-language-server" (lib.unique (builtins.attrValues allPackages)); # Same for all shells - all-nix-dev-shells = linkFarmFromDrvs "all-dev-shells" - (builtins.map (shell: shell.inputDerivation) (lib.unique (builtins.attrValues nixDevShells))); + # We try to build as much as possible, but not much shells are + # working (especially on darwing), so this list is limited. + all-nix-dev-shells = linkFarmFromDrvs "all-dev-shells" (builtins.map (shell: shell.inputDerivation) (lib.unique [nixDevShells.haskell-language-server-dev-nix])); all-simple-dev-shells = linkFarmFromDrvs "all-simple-dev-shells" (builtins.map (shell: shell.inputDerivation) (lib.unique (builtins.attrValues simpleDevShells))); diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index f3e07d51a6..17771d7928 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -68,7 +68,7 @@ library hls-plugin-api ^>= 1.6, lens, list-t, - hiedb == 0.4.2.*, + hiedb == 0.4.3.*, lsp-types ^>= 1.6.0.0, lsp ^>= 1.6.0.0 , mtl, diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 9d511e9f4f..1f70e9653b 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -36,6 +36,7 @@ module Development.IDE.Core.Compile , TypecheckHelpers(..) ) where +import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) import Control.DeepSeq (NFData (..), force, liftRnf, @@ -133,6 +134,11 @@ import GHC.Hs (LEpaComment) import qualified GHC.Types.Error as Error #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Driver.Config.CoreToStg.Prep +import GHC.Core.Lint.Interactive +#endif + -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule :: IdeOptions @@ -467,7 +473,11 @@ mkHiFileResultNoCompile session tcm = do tcGblEnv = tmrTypechecked tcm details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv - iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv + iface' <- mkIfaceTc hsc_env_tmp sf details ms +#if MIN_VERSION_ghc(9,5,0) + Nothing +#endif + tcGblEnv let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing @@ -482,20 +492,19 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do ms = pm_mod_summary $ tmrParsed tcm tcGblEnv = tmrTypechecked tcm - (details, mguts) <- - if mg_hsc_src simplified_guts == HsBootFile - then do - details <- mkBootModDetailsTc session tcGblEnv - pure (details, Nothing) - else do + (details, guts) <- do -- write core file -- give variables unique OccNames tidy_opts <- initTidyOpts session (guts, details) <- tidyProgram tidy_opts simplified_guts - pure (details, Just guts) + pure (details, guts) #if MIN_VERSION_ghc(9,0,1) - let !partial_iface = force $ mkPartialIface session details + let !partial_iface = force $ mkPartialIface session +#if MIN_VERSION_ghc(9,5,0) + (cg_binds guts) +#endif + details #if MIN_VERSION_ghc(9,3,0) ms #endif @@ -513,9 +522,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] -- Write the core file now - core_file <- case mguts of - Nothing -> pure Nothing -- no guts, likely boot file - Just guts -> do + core_file <- do let core_fp = ml_core_file $ ms_location ms core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface @@ -538,13 +545,23 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do Just (core, _) | optVerifyCoreFile -> do let core_fp = ml_core_file $ ms_location ms traceIO $ "Verifying " ++ core_fp - let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = case mguts of - Nothing -> error "invariant optVerifyCoreFile: guts must exist if linkable exists" - Just g -> g + let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts mod = ms_mod ms data_tycons = filter isDataTyCon tycons CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core +#if MIN_VERSION_ghc(9,5,0) + cp_cfg <- initCorePrepConfig session +#endif + + let corePrep = corePrepPgm +#if MIN_VERSION_ghc(9,5,0) + (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session)) +#else + session +#endif + 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 #if MIN_VERSION_ghc(9,3,0) @@ -552,13 +569,13 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do #else (prepd_binds , _) #endif - <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons + <- corePrep unprep_binds data_tycons #if MIN_VERSION_ghc(9,3,0) prepd_binds' #else (prepd_binds', _) #endif - <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons + <- corePrep unprep_binds' data_tycons let binds = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds' @@ -683,7 +700,7 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) -- TODO: maybe settings ms_hspp_opts is unnecessary? summary' = summary { ms_hspp_opts = hsc_dflags session } - hscInteractive session guts + hscInteractive session (mkCgInteractiveGuts guts) (ms_location summary') let unlinked = BCOs bytecode sptEntries let linkable = LM time (ms_mod summary) [unlinked] @@ -1220,7 +1237,9 @@ parseHeader => DynFlags -- ^ flags to use -> FilePath -- ^ the filename (for source locations) -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,5,0) + -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) +#elif MIN_VERSION_ghc(9,0,1) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) #else -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) @@ -1552,13 +1571,13 @@ showReason (RecompBecause s) = s mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails mkDetailsFromIface session iface = do fixIO $ \details -> do - let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session + let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session initIfaceLoad hsc' (typecheckIface iface) coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts coreFileToCgGuts session iface details core_file = do let act hpt = addToHpt hpt (moduleName this_mod) - (HomeModInfo iface details Nothing) + (HomeModInfo iface details emptyHomeModInfoLinkable) this_mod = mi_module iface types_var <- newIORef (md_types details) let hsc_env' = hscUpdateHPT act (session { @@ -1572,7 +1591,10 @@ coreFileToCgGuts session iface details core_file = do -- Implicit binds aren't saved, so we need to regenerate them ourselves. let implicit_binds = concatMap getImplicitBinds tyCons tyCons = typeEnvTyCons (md_types details) -#if MIN_VERSION_ghc(9,3,0) +#if MIN_VERSION_ghc(9,5,0) + -- In GHC 9.6, the implicit binds are tidied and part of core_binds + pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] +#elif MIN_VERSION_ghc(9,3,0) pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #else pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing [] @@ -1582,9 +1604,9 @@ coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDet coreFileToLinkable linkableType session ms iface details core_file t = do cgi_guts <- coreFileToCgGuts session iface details core_file (warns, lb) <- case linkableType of - BCOLinkable -> generateByteCode (CoreFileTime t) session ms cgi_guts - ObjectLinkable -> generateObjectCode session ms cgi_guts - pure (warns, HomeModInfo iface details . Just <$> lb) + BCOLinkable -> fmap (maybe emptyHomeModInfoLinkable justBytecode) <$> generateByteCode (CoreFileTime t) session ms cgi_guts + ObjectLinkable -> fmap (maybe emptyHomeModInfoLinkable justObjects) <$> generateObjectCode session ms cgi_guts + pure (warns, Just $ HomeModInfo iface details lb) -- TODO wz1000 handle emptyHomeModInfoLinkable -- | Non-interactive, batch version of 'InteractiveEval.getDocs'. -- The interactive paths create problems in ghc-lib builds diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 76afeaeb67..91f1bb5a88 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -204,7 +204,7 @@ runCpp env0 filename contents = withTempDir $ \dir -> do -- Happy case, file is not modified, so run CPP on it in-place -- which also makes things like relative #include files work -- and means location information is correct - doCpp env1 True filename out + doCpp env1 filename out liftIO $ Util.hGetStringBuffer out Just contents -> do @@ -218,7 +218,7 @@ runCpp env0 filename contents = withTempDir $ \dir -> do let inp = dir "___GHCIDE_MAGIC___" withBinaryFile inp WriteMode $ \h -> hPutStringBuffer h contents - doCpp env2 True inp out + doCpp env2 inp out -- Fix up the filename in lines like: -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___" diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 934df8ced7..64bdb1d8b0 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -63,6 +63,7 @@ module Development.IDE.Core.Rules( DisplayTHWarning(..), ) where +import Control.Applicative import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict import Control.DeepSeq @@ -161,6 +162,9 @@ import Control.Monad.IO.Unlift import GHC.Unit.Module.Graph import GHC.Unit.Env #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Unit.Home.ModInfo +#endif data Log = LogShake Shake.Log @@ -776,7 +780,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps ifaces <- uses_ GetModIface deps - let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces + let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces #if MIN_VERSION_ghc(9,3,0) -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph -- also points to all the direct descendants of the current module. To get the keys for the descendants @@ -1100,10 +1104,10 @@ getLinkableRule recorder = else pure Nothing case mobj_time of Just obj_t - | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file])) + | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file])) _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time") -- Record the linkable so we know not to unload it, and unload old versions - whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do + whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction liftIO $ modifyVar compiledLinkables $ \old -> do let !to_keep = extendModuleEnv old mod time diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 7495de21a4..1cb70cc174 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -15,6 +15,7 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where +import Control.Monad import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC @@ -26,6 +27,11 @@ import GHC.Settings import qualified DriverPipeline as Pipeline import ToolSettings #endif + +#if MIN_VERSION_ghc(9,5,0) +import qualified GHC.SysTools.Cpp as Pipeline +#endif + #if MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif @@ -39,11 +45,24 @@ addOptP f = alterToolSettings $ \s -> s fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO () -doCpp env raw input_fn output_fn = -#if MIN_VERSION_ghc (9,2,0) - Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) raw input_fn output_fn +doCpp :: HscEnv -> FilePath -> FilePath -> IO () +doCpp env input_fn output_fn = + -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850 + -- this function/Pipeline.doCpp previously had a raw parameter + -- always set to True that corresponded to these settings + +#if MIN_VERSION_ghc(9,5,0) + let cpp_opts = Pipeline.CppOpts + { cppUseCc = False + , cppLinePragmas = True + } in +#else + let cpp_opts = True in +#endif + +#if MIN_VERSION_ghc(9,2,0) + Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn #else - Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn + Pipeline.doCpp (hsc_dflags env) cpp_opts input_fn output_fn #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 4c9ca9c9a2..0f9069b006 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -134,6 +134,11 @@ module Development.IDE.GHC.Compat( #else coreExprToBCOs, linkExpr, +#endif + extract_cons, + recDotDot, +#if MIN_VERSION_ghc(9,5,0) + XModulePs(..), #endif ) where @@ -157,7 +162,15 @@ import Data.String (IsString (fromString)) #if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,5,0) +import GHC.Core.Lint.Interactive (interactiveInScope) +import GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr) +import GHC.Driver.Config.Core.Opt.Simplify (initSimplifyExprOpts) +import GHC.Driver.Config.CoreToStg (initCoreToStgOpts) +import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) +#else import GHC.Core.Lint (lintInteractiveExpr) +#endif import qualified GHC.Core.Opt.Pipeline as GHC import GHC.Core.Tidy (tidyExpr) import GHC.CoreToStg.Prep (corePrepPgm) @@ -310,7 +323,11 @@ myCoreToStgExpr logger dflags ictxt binding for the stg2stg step) -} let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel") (mkPseudoUniqueE 0) +#if MIN_VERSION_ghc(9,5,0) + ManyTy +#else Many +#endif (exprType prepd_expr) (stg_binds, prov_map, collected_ccs) <- myCoreToStg logger @@ -343,7 +360,13 @@ myCoreToStg logger dflags ictxt this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} - coreToStg dflags this_mod ml prepd_binds + coreToStg +#if MIN_VERSION_ghc(9,5,0) + (initCoreToStgOpts dflags) +#else + dflags +#endif + this_mod ml prepd_binds #if MIN_VERSION_ghc(9,4,2) (stg_binds2,_) @@ -352,7 +375,13 @@ myCoreToStg logger dflags ictxt #endif <- {-# SCC "Stg2Stg" #-} #if MIN_VERSION_ghc(9,3,0) - stg2stg logger ictxt (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds + stg2stg logger +#if MIN_VERSION_ghc(9,5,0) + (interactiveInScope ictxt) +#else + ictxt +#endif + (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds #else stg2stg logger dflags ictxt this_mod stg_binds #endif @@ -380,10 +409,21 @@ getDependentMods = map fst . dep_mods . mi_deps simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr #if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,5,0) +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)) +#else simplifyExpr _ = GHC.simplifyExpr +#endif corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr +#if MIN_VERSION_ghc(9,5,0) +corePrepExpr _ env exp = do + cfg <- initCorePrepConfig env + GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg exp +#else corePrepExpr _ = GHC.corePrepExpr +#endif + #else simplifyExpr df _ = GHC.simplifyExpr df #endif @@ -575,13 +615,16 @@ data GhcVersion | GHC90 | GHC92 | GHC94 + | GHC96 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) +ghcVersion = GHC96 +#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) ghcVersion = GHC94 #elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) ghcVersion = GHC92 @@ -677,3 +720,17 @@ loadModulesHome mod_infos e = where mod_name = moduleName . mi_module . hm_iface #endif + +recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int +recDotDot x = +#if MIN_VERSION_ghc(9,5,0) + unRecFieldsDotDot <$> +#endif + unLoc <$> rec_dotdot x + +#if MIN_VERSION_ghc(9,5,0) +extract_cons (NewTypeCon x) = [x] +extract_cons (DataTypeCons _ xs) = xs +#else +extract_cons = id +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index e4b1b2b6d7..8794f44db4 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -263,7 +263,7 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.noSrcSpan, SrcLoc.noSrcLoc, SrcLoc.noLoc, - SrcLoc.mapLoc, + mapLoc, -- * Finder FindResult(..), mkHomeModLocation, @@ -487,6 +487,15 @@ module Development.IDE.GHC.Compat.Core ( Extension(..), #endif UniqFM, + mkCgInteractiveGuts, + justBytecode, + justObjects, + emptyHomeModInfoLinkable, + homeModInfoByteCode, + homeModInfoObject, +# if !MIN_VERSION_ghc(9,5,0) + field_label, +#endif ) where import qualified GHC @@ -1183,3 +1192,34 @@ type UniqFM = UniqFM.UniqFM #else type UniqFM k = UniqFM.UniqFM #endif + +#if MIN_VERSION_ghc(9,5,0) +mkVisFunTys = mkScaledFunctionTys +mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b +mapLoc = fmap +#else +mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b +mapLoc = SrcLoc.mapLoc +#endif + + +#if !MIN_VERSION_ghc(9,5,0) +mkCgInteractiveGuts :: CgGuts -> CgGuts +mkCgInteractiveGuts = id + +emptyHomeModInfoLinkable :: Maybe Linkable +emptyHomeModInfoLinkable = Nothing + +justBytecode :: Linkable -> Maybe Linkable +justBytecode = Just + +justObjects :: Linkable -> Maybe Linkable +justObjects = Just + +homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable +homeModInfoByteCode = hm_linkable +homeModInfoObject = hm_linkable + +field_label :: a -> a +field_label = id +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 596593376d..25ea24123b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -82,7 +82,11 @@ import qualified GHC.Driver.Ways as Ways #endif import GHC.Driver.Hooks (Hooks) import GHC.Driver.Session hiding (mkHomeModule) +#if __GLASGOW_HASKELL__ >= 905 +import Language.Haskell.Syntax.Module.Name +#else import GHC.Unit.Module.Name +#endif import GHC.Unit.Types (Module, Unit, UnitId, mkModule) #else import DynFlags @@ -230,7 +234,9 @@ mkHomeModule = setBytecodeLinkerOptions :: DynFlags -> DynFlags setBytecodeLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + , backend = noBackend +#elif MIN_VERSION_ghc(9,2,0) , backend = NoBackend #else , hscTarget = HscNothing @@ -241,7 +247,9 @@ setBytecodeLinkerOptions df = df { setInterpreterLinkerOptions :: DynFlags -> DynFlags setInterpreterLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + , backend = interpreterBackend +#elif MIN_VERSION_ghc(9,2,0) , backend = Interpreter #else , hscTarget = HscInterpreted diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index cffac134ab..d7bc9deadc 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -49,7 +49,11 @@ type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> S -- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. logActionCompat :: LogActionCompat -> LogAction +#if MIN_VERSION_ghc(9,5,0) +logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +#else logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +#endif logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 10200cd129..c4f9cd57bd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -9,7 +9,6 @@ module Development.IDE.GHC.Compat.Outputable ( ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate, printSDocQualifiedUnsafe, printWithoutUniques, - mkPrintUnqualified, mkPrintUnqualifiedDefault, PrintUnqualified(..), defaultUserStyle, @@ -17,6 +16,10 @@ module Development.IDE.GHC.Compat.Outputable ( -- * Parser errors PsWarning, PsError, +#if MIN_VERSION_ghc(9,5,0) + defaultDiagnosticOpts, + GhcMessage, +#endif #if MIN_VERSION_ghc(9,3,0) DiagnosticReason(..), renderDiagnosticMessageWithHints, @@ -43,6 +46,7 @@ module Development.IDE.GHC.Compat.Outputable ( mkWarnMsg, mkSrcErr, srcErrorMessages, + textDoc, ) where @@ -88,12 +92,19 @@ import Outputable as Out hiding import qualified Outputable as Out import SrcLoc #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Driver.Errors.Types (GhcMessage) +#endif #if MIN_VERSION_ghc(9,3,0) import Data.Maybe import GHC.Driver.Config.Diagnostic import GHC.Utils.Logger #endif +#if MIN_VERSION_ghc(9,5,0) +type PrintUnqualified = NamePprCtx +#endif + -- | A compatible function to print `Outputable` instances -- without unique symbols. -- @@ -211,7 +222,11 @@ type WarnMsg = MsgEnvelope DecoratedSDoc mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + mkNamePprCtx ptc (hsc_unit_env env) + where + ptc = initPromotionTickContext (hsc_dflags env) +#elif MIN_VERSION_ghc(9,2,0) -- GHC 9.2 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified (hsc_unit_env env) @@ -220,8 +235,13 @@ mkPrintUnqualifiedDefault env = #endif #if MIN_VERSION_ghc(9,3,0) -renderDiagnosticMessageWithHints :: Diagnostic a => a -> DecoratedSDoc -renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc (diagnosticMessage a) (mkDecorated $ map ppr $ diagnosticHints a) +renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc +renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc + (diagnosticMessage +#if MIN_VERSION_ghc(9,5,0) + (defaultDiagnosticOpts @a) +#endif + a) (mkDecorated $ map ppr $ diagnosticHints a) #endif #if MIN_VERSION_ghc(9,3,0) @@ -243,3 +263,6 @@ defaultUserStyle = Out.defaultUserStyle #else defaultUserStyle = Out.defaultUserStyle unsafeGlobalDynFlags #endif + +textDoc :: String -> SDoc +textDoc = text diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 11773d233c..2fd5b74efd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -120,7 +120,11 @@ type ApiAnns = Anno.ApiAnns #endif #if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) +pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> ApiAnns -> GHC.HsParsedModule +#else pattern HsParsedModule :: Located HsModule -> [FilePath] -> ApiAnns -> GHC.HsParsedModule +#endif pattern HsParsedModule { hpm_module , hpm_src_files diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index a96c8be564..4bf7454ab5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -99,6 +99,7 @@ import qualified Packages import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import Data.Map (Map) #endif @@ -400,7 +401,7 @@ filterInplaceUnits us packageFlags = #endif isInplace p = Right p -showSDocForUser' :: HscEnv -> GHC.PrintUnqualified -> SDoc -> String +showSDocForUser' :: HscEnv -> PrintUnqualified -> SDoc -> String #if MIN_VERSION_ghc(9,2,0) showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env) #else diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 00a778afda..ed11a26300 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -136,8 +136,12 @@ codeGutsToCoreFile :: Fingerprint -- ^ Hash of the interface this was generated from -> CgGuts -> CoreFile -codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind cg_module) $ filter isNotImplictBind cg_binds) hash - +#if MIN_VERSION_ghc(9,5,0) +-- In GHC 9.6, implicit binds are tidied and part of core binds +codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) cg_binds) hash +#else +codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ filter isNotImplictBind cg_binds) hash +#endif -- | Implicit binds can be generated from the interface and are not tidied, -- so we must filter them out isNotImplictBind :: CoreBind -> Bool @@ -165,21 +169,21 @@ getClassImplicitBinds cls get_defn :: Id -> CoreBind get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) -toIfaceTopBndr :: Module -> Id -> IfaceId -toIfaceTopBndr mod id +toIfaceTopBndr1 :: Module -> Id -> IfaceId +toIfaceTopBndr1 mod id = IfaceId (mangleDeclName mod $ getName id) (toIfaceType (idType id)) (toIfaceIdDetails (idDetails id)) (toIfaceIdInfo (idInfo id)) -toIfaceTopBind :: Module -> Bind Id -> TopIfaceBinding IfaceId -toIfaceTopBind mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr mod b) (toIfaceExpr r) -toIfaceTopBind mod (Rec prs) = TopIfaceRec [(toIfaceTopBndr mod b, toIfaceExpr r) | (b,r) <- prs] +toIfaceTopBind1 :: Module -> Bind Id -> TopIfaceBinding IfaceId +toIfaceTopBind1 mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr1 mod b) (toIfaceExpr r) +toIfaceTopBind1 mod (Rec prs) = TopIfaceRec [(toIfaceTopBndr1 mod b, toIfaceExpr r) | (b,r) <- prs] typecheckCoreFile :: Module -> IORef TypeEnv -> CoreFile -> IfG CoreProgram typecheckCoreFile this_mod type_var (CoreFile prepd_binding _) = initIfaceLcl this_mod (text "typecheckCoreFile") NotBoot $ do - tcTopIfaceBindings type_var prepd_binding + tcTopIfaceBindings1 type_var prepd_binding -- | Internal names can't be serialized, so we mange them -- to an external name and restore at deserialization time @@ -201,9 +205,9 @@ isGhcideModule mod = "GHCIDEINTERNAL" `isPrefixOf` (moduleNameString $ moduleNam isGhcideName :: Name -> Bool isGhcideName = isGhcideModule . nameModule -tcTopIfaceBindings :: IORef TypeEnv -> [TopIfaceBinding IfaceId] +tcTopIfaceBindings1 :: IORef TypeEnv -> [TopIfaceBinding IfaceId] -> IfL [CoreBind] -tcTopIfaceBindings ty_var ver_decls +tcTopIfaceBindings1 ty_var ver_decls = do int <- mapM (traverse $ tcIfaceId) ver_decls let all_ids = concatMap toList int diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 9e3d206d0e..563a10b5eb 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -46,6 +46,9 @@ import ByteCodeTypes #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Unit.Home.ModInfo +#endif -- Orphan instances for types from the GHC API. instance Show CoreModule where show = unpack . printOutputable @@ -92,8 +95,10 @@ instance Show Module where instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable #endif +#if !MIN_VERSION_ghc(9,5,0) instance (NFData l, NFData e) => NFData (GenLocated l e) where rnf (L l e) = rnf l `seq` rnf e +#endif instance Show ModSummary where show = show . ms_mod @@ -184,8 +189,10 @@ instance NFData Type where instance Show a => Show (Bag a) where show = show . bagToList +#if !MIN_VERSION_ghc(9,5,0) instance NFData HsDocString where rnf = rwhnf +#endif instance Show ModGuts where show _ = "modguts" @@ -195,7 +202,9 @@ instance NFData ModGuts where instance NFData (ImportDecl GhcPs) where rnf = rwhnf -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,5,0) +instance (NFData (HsModule a)) where +#elif MIN_VERSION_ghc(9,0,1) instance (NFData HsModule) where #else instance (NFData (HsModule a)) where @@ -222,3 +231,8 @@ instance NFData UnitId where instance NFData NodeKey where rnf = rwhnf #endif + +#if MIN_VERSION_ghc(9,5,0) +instance NFData HomeModLinkable where + rnf = rwhnf +#endif diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index b31cd90f7b..7afcb5bfdd 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -11,6 +11,7 @@ where import Control.Monad.IO.Class import Data.Functor +import Data.Foldable (toList) import Data.Generics hiding (Prefix) import Data.Maybe import qualified Data.Text as T @@ -30,7 +31,7 @@ import Language.LSP.Types (DocumentSymbol (..), TextDocumentIdentifier (TextDocumentIdentifier), type (|?) (InL), uriToFilePath) #if MIN_VERSION_ghc(9,2,0) -import Data.List.NonEmpty (nonEmpty, toList) +import Data.List.NonEmpty (nonEmpty) #endif moduleOutline @@ -111,7 +112,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam #if MIN_VERSION_ghc(9,2,0) , _children = List . toList <$> nonEmpty childs } - | con <- dd_cons + | con <- extract_cons dd_cons , let (cs, flds) = hsConDeclsBinders con , let childs = mapMaybe cvtFld flds , L (locA -> RealSrcSpan l' _) n <- cs @@ -291,7 +292,7 @@ hsConDeclsBinders cons -- remove only the first occurrence of any seen field in order to -- avoid circumventing detection of duplicate fields (#9156) ConDeclGADT { con_names = names, con_g_args = args } - -> (names, flds) + -> (toList names, flds) where flds = get_flds_gadt args @@ -318,3 +319,5 @@ hsConDeclsBinders cons -> ([LFieldOcc GhcPs]) get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) #endif + + diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 0442acef14..9dc28d379d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -106,8 +106,13 @@ produceCompletions recorder = do -- Drop any explicit imports in ImportDecl if not hidden dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs dropListFromImportDecl iDecl = let +#if MIN_VERSION_ghc(9,5,0) + f d@ImportDecl {ideclImportList} = case ideclImportList of + Just (Exactly, _) -> d {ideclImportList=Nothing} +#else f d@ImportDecl {ideclHiding} = case ideclHiding of Just (False, _) -> d {ideclHiding=Nothing} +#endif -- if hiding or Nothing just return d _ -> d f x = x diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 362fb68993..677cd741d4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -75,6 +75,10 @@ import Development.IDE import Development.IDE.Spans.AtPoint (pointCommand) +#if MIN_VERSION_ghc(9,5,0) +import Language.Haskell.Syntax.Basic +#endif + -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int chunkSize = 1000 @@ -138,17 +142,29 @@ getCContext pos pm importGo :: GHC.LImportDecl GhcPs -> Maybe Context importGo (L (locA -> r) impDecl) | pos `isInsideSrcSpan` r +#if MIN_VERSION_ghc(9,5,0) + = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl) +#else = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl) +#endif <|> Just (ImportContext importModuleName) | otherwise = Nothing where importModuleName = moduleNameString $ unLoc $ ideclName impDecl - importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context + -- importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context +#if MIN_VERSION_ghc(9,5,0) + importInline modName (Just (EverythingBut, L r _)) +#else importInline modName (Just (True, L r _)) +#endif | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName | otherwise = Nothing +#if MIN_VERSION_ghc(9,5,0) + importInline modName (Just (Exactly, L r _)) +#else importInline modName (Just (False, L r _)) +#endif | pos `isInsideSrcSpan` r = Just $ ImportListContext modName | otherwise = Nothing importInline _ _ = Nothing @@ -384,7 +400,7 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = | isDataConName n , Just flds <- Map.lookup parent fieldMap , not (null flds) -> - [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS) flds) (ImportedFrom mn) imp'] + [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS . field_label) flds) (ImportedFrom mn) imp'] _ -> [] in mkNameCompItem uri mbParent originName (ImportedFrom mn) Nothing imp' (nameModule_maybe n) @@ -467,7 +483,7 @@ findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result where result = [mkRecordSnippetCompItem uri (Just $ printOutputable $ unLoc tcdLName) (printOutputable . unLoc $ con_name) field_labels mn Nothing - | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn + | ConDeclH98{..} <- unLoc <$> (extract_cons $ dd_cons tcdDataDefn) , Just con_details <- [getFlds con_args] , let field_names = concatMap extract con_details , let field_labels = printOutputable <$> field_names diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 9ae0665998..2ec1e98e94 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -34,7 +34,11 @@ type DocMap = NameEnv SpanDoc type KindMap = NameEnv TyThing -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. +#if MIN_VERSION_ghc(9,5,0) +unqualIEWrapName :: IEWrappedName GhcPs -> T.Text +#else unqualIEWrapName :: IEWrappedName RdrName -> T.Text +#endif unqualIEWrapName = printOutputable . rdrNameOcc . ieWrappedName -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index d61105801c..d8491c72e1 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -51,9 +51,9 @@ instance NFData ExportsMap where instance Show ExportsMap where show (ExportsMap occs mods) = unwords [ "ExportsMap { getExportsMap =" - , printWithoutUniques $ mapOccEnv (text . show) occs + , printWithoutUniques $ mapOccEnv (textDoc . show) occs , "getModuleExportsMap =" - , printWithoutUniques $ mapUFM (text . show) mods + , printWithoutUniques $ mapUFM (textDoc . show) mods , "}" ] diff --git a/ghcide/test/data/multi/a/a.cabal b/ghcide/test/data/multi/a/a.cabal index 7675345ca1..d95697264d 100644 --- a/ghcide/test/data/multi/a/a.cabal +++ b/ghcide/test/data/multi/a/a.cabal @@ -4,6 +4,6 @@ build-type: Simple cabal-version: >= 1.2 library - build-depends: base, async + build-depends: base, async >= 2.0 exposed-modules: A hs-source-dirs: . diff --git a/ghcide/test/data/multi/cabal.project b/ghcide/test/data/multi/cabal.project index 21bbb8b27b..317a89138e 100644 --- a/ghcide/test/data/multi/cabal.project +++ b/ghcide/test/data/multi/cabal.project @@ -1 +1,3 @@ packages: a b c + +allow-newer: base diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 7e8ac70c56..231014a071 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -596,13 +596,19 @@ diagnosticTests = testGroup "diagnostics" expectDiagnostics [ ( "Main.hs" , [(DsError, (6, 9), - if ghcVersion >= GHC94 - then "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 - else "Not in scope: \8216ThisList.map\8217") + if ghcVersion >= GHC96 then + "Variable not in scope: ThisList.map" + else if ghcVersion >= GHC94 then + "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 + else + "Not in scope: \8216ThisList.map\8217") ,(DsError, (7, 9), - if ghcVersion >= GHC94 - then "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 - else "Not in scope: \8216BaseList.x\8217") + if ghcVersion >= GHC96 then + "Variable not in scope: BaseList.x" + else if ghcVersion >= GHC94 then + "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 + else + "Not in scope: \8216BaseList.x\8217") ] ) ] @@ -950,7 +956,7 @@ addSigLensesTests = , ("head = 233", "head :: Integer") , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")") , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") - , ("promotedKindTest = Proxy @Nothing", "promotedKindTest :: Proxy 'Nothing") + , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") , ("typeOperatorTest = Refl", if ghcVersion >= GHC92 then "typeOperatorTest :: forall {k} {a :: k}. a :~: a" else "typeOperatorTest :: a :~: a") , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType") ] @@ -1242,6 +1248,7 @@ pluginSimpleTests = -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is -- required by plugin-1.0.0). See the build log above for details. + ignoreFor (BrokenForGHC [GHC96]) "fragile, frequently times out" $ ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" @@ -1776,7 +1783,7 @@ nonLocalCompletionTests = [] ] where - brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94]) "Windows has strange things in scope for some reason" + brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94, GHC96]) "Windows has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ @@ -2008,7 +2015,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"] - , testSession "local single line doc without '\\n'" $ do + , testSession "local single line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- |docdoc" @@ -2016,7 +2023,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"] - , testSession "local multi line doc with '\\n'" $ do + , testSession "local multi line doc with newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -2025,7 +2032,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"] - , testSession "local multi line doc without '\\n'" $ do + , testSession "local multi line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -2065,10 +2072,10 @@ completionDocTests = test doc (Position 1 7) "id" (Just $ T.length expected) [expected] ] where - brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9" + brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94, GHC96]) "Completion doc doesn't support ghc9" brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2" -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903 - brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9" + brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9" test doc pos label mn expected = do _ <- waitForDiagnostics compls <- getCompletions doc pos @@ -2116,7 +2123,7 @@ highlightTests = testGroup "highlight" , DocumentHighlight (R 6 10 6 13) (Just HkRead) , DocumentHighlight (R 7 12 7 15) (Just HkRead) ] - , knownBrokenForGhcVersions [GHC90, GHC92, GHC94] "Ghc9 highlights the constructor and not just this field" $ + , knownBrokenForGhcVersions [GHC90, GHC92, GHC94, GHC96] "Ghc9 highlights the constructor and not just this field" $ testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics @@ -2347,7 +2354,7 @@ ignoreInWindowsForGHC810 = ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10" ignoreForGHC92Plus :: String -> TestTree -> TestTree -ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94]) +ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96]) knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 867546f05f..2915f11872 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -267,7 +267,7 @@ common tactic cpp-options: -Dhls_tactic common hlint - if flag(hlint) + if flag(hlint) && impl(ghc < 9.5) build-depends: hls-hlint-plugin ^>= 1.1 cpp-options: -Dhls_hlint @@ -329,22 +329,22 @@ common explicitFields -- formatters common floskell - if flag(floskell) + if flag(floskell) && impl(ghc < 9.5) build-depends: hls-floskell-plugin ^>= 1.0 cpp-options: -Dhls_floskell common fourmolu - if flag(fourmolu) + if flag(fourmolu) && impl(ghc < 9.5) build-depends: hls-fourmolu-plugin ^>= 1.1 cpp-options: -Dhls_fourmolu common ormolu - if flag(ormolu) + if flag(ormolu) && impl(ghc < 9.5) build-depends: hls-ormolu-plugin ^>= 1.0 cpp-options: -Dhls_ormolu common stylishHaskell - if flag(stylishHaskell) + if flag(stylishHaskell) && impl(ghc < 9.5) build-depends: hls-stylish-haskell-plugin ^>= 1.0 cpp-options: -Dhls_stylishHaskell diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index 6e3d829d95..6af7c457f6 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -29,7 +29,7 @@ flag ghc-lib library default-language: Haskell2010 build-depends: - base < 4.18, array, bytestring, containers, directory, filepath, transformers + base < 4.19, array, bytestring, containers, directory, filepath, transformers if flag(ghc-lib) && impl(ghc < 9) build-depends: ghc-lib < 9.0 else @@ -52,5 +52,5 @@ library hs-source-dirs: src-ghc90 src-reexport-ghc9 if (impl(ghc >= 9.2) && impl(ghc < 9.3)) hs-source-dirs: src-ghc92 src-reexport-ghc9 - if (impl(ghc >= 9.4) && impl(ghc < 9.5)) + if (impl(ghc >= 9.4) && impl(ghc < 9.7)) hs-source-dirs: src-reexport-ghc92 diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs index 364179a4d5..3b90cec4fb 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs @@ -5,7 +5,8 @@ module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where import Control.Lens ((^.)) -import Control.Monad.Except (ExceptT, MonadIO, liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Except (ExceptT) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text, unpack) import qualified Data.Text as T diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index bf82c11a54..2c979e10d9 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -44,7 +44,7 @@ library -- automatically, forcing us to manually update the packages revision id. -- This is a lot of work for almost zero benefit, so we just allow more versions here -- and we eventually completely drop support for building HLS with stack. - , Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 || ^>= 3.8 + , Cabal ^>=3.2 || ^>=3.4 || ^>=3.6 || ^>= 3.8 || ^>= 3.10 , deepseq , directory , extra >=1.7.4 diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index 84d9b8ef90..0a89571d0b 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -40,7 +40,7 @@ test :: TestTree test = testGroup "changeTypeSignature" [ testRegexes , codeActionTest "TExpectedActual" 4 11 - , knownBrokenForGhcVersions [GHC92, GHC94] "Error Message in 9.2/9.4 does not provide enough info" $ codeActionTest "TRigidType" 4 14 + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "Error Message in 9.2/9.4 does not provide enough info" $ codeActionTest "TRigidType" 4 14 , codeActionTest "TRigidType2" 4 6 , codeActionTest "TLocalBinding" 7 22 , codeActionTest "TLocalBindingShadow1" 11 8 diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs index 03c2f11824..44d3857c86 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-overlapping-patterns #-} module Ide.Plugin.Class.CodeLens where @@ -96,7 +97,11 @@ codeLens state plId CodeLensParams{..} = pluginResponse $ do -- that are nonsense for displaying code lenses. -- -- See https://github.com/haskell/haskell-language-server/issues/3319 - | not $ isGenerated (mg_origin fun_matches) +#if MIN_VERSION_ghc(9,5,0) + | not $ isGenerated (mg_ext fun_matches) +#else + | not $ isGenerated (mg_origin fun_matches) +#endif -> Just $ L l fun_id _ -> Nothing -- Existed signatures' name diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 08e3586d98..32fe788701 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -35,6 +35,7 @@ import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (ExceptT (..)) import Data.Aeson (toJSON) import Data.Char (isSpace) +import Data.Foldable (toList) import qualified Data.HashMap.Strict as HashMap import Data.List (dropWhileEnd, find, @@ -588,7 +589,7 @@ doInfoCmd allInfo dflags s = do names <- GHC.parseName str mb_stuffs <- mapM (GHC.getInfo allInfo) names let filtered = filterOutChildren (\(t,_f,_ci,_fi,_sd) -> t) - (catMaybes mb_stuffs) + (catMaybes $ toList mb_stuffs) return $ vcat (intersperse (text "") $ map pprInfo filtered) filterOutChildren :: (a -> TyThing) -> [a] -> [a] diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs index 1a9c94c98b..4413850398 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs @@ -67,8 +67,13 @@ queueForEvaluation ide nfp = do modifyIORef var (Set.insert nfp) #if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) +getAnnotations :: Development.IDE.GHC.Compat.Located (HsModule GhcPs) -> [LEpaComment] +getAnnotations (L _ m@(HsModule { hsmodExt = XModulePs {hsmodAnn = anns'}})) = +#else getAnnotations :: Development.IDE.GHC.Compat.Located HsModule -> [LEpaComment] getAnnotations (L _ m@(HsModule { hsmodAnn = anns'})) = +#endif priorComments annComments <> getFollowingComments annComments <> concatMap getCommentsForDecl (hsmodImports m) <> concatMap getCommentsForDecl (hsmodDecls m) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 80e5df6415..2b8c41ec2e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} @@ -38,7 +39,7 @@ timed out name op = do _ <- out name (showDuration secs) return r --- |Log using hie logger, reports source position of logging statement +-- | Log using hie logger, reports source position of logging statement logWith :: (HasCallStack, MonadIO m, Show a1, Show a2) => IdeState -> a1 -> a2 -> m () logWith state key val = liftIO . logPriority (ideLogger state) logLevel $ @@ -90,7 +91,12 @@ showErr e = Just (SourceError msgs) -> return $ Left $ renderWithContext defaultSDocContext $ vcat $ bagToList - $ fmap (vcat . unDecorated . diagnosticMessage . errMsgDiagnostic) + $ fmap (vcat . unDecorated + . diagnosticMessage +#if MIN_VERSION_ghc(9,5,0) + (defaultDiagnosticOpts @GhcMessage) +#endif + . errMsgDiagnostic) $ getMessages msgs _ -> #endif diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index c33b2c3aa3..26ab573a73 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -74,6 +74,7 @@ tests = evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName" evalInFile "T8.hs" "-- >>> res = \"a\" + \"bc\"" $ if + | ghcVersion >= GHC96 -> "-- No instance for `Num String' arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\"" | ghcVersion >= GHC92 -> "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\"" | ghcVersion == GHC90 -> "-- No instance for (Num String) arising from a use of ‘+’" | otherwise -> "-- No instance for (Num [Char]) arising from a use of ‘+’" @@ -81,11 +82,15 @@ tests = evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero" -- The default for marking exceptions is False , goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs" , goldenWithEval' "Evaluate a type with :kind!" "T10" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") - , goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" ( + if ghcVersion >= GHC94 then "ghc94.expected" + else if ghcVersion >= GHC92 then "ghc92.expected" + else "expected" + ) , goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs" - , knownBrokenForGhcVersions [GHC92, GHC94] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" , goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" @@ -135,7 +140,16 @@ tests = , goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs" , goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs" , goldenWithEval "Property checking" "TProperty" "hs" - , goldenWithEval' "Property checking with exception" "TPropertyError" "hs" (if ghcVersion >= GHC94 then "ghc94.expected" else "expected") + , goldenWithEval' "Property checking with exception" "TPropertyError" "hs" ( + if ghcVersion >= GHC96 then + "ghc96.expected" + else if ghcVersion >= GHC94 && hostOS == Windows then + "windows-ghc94.expected" + else if ghcVersion >= GHC94 then + "ghc94.expected" + else + "expected" + ) , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs" , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs" , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs" diff --git a/plugins/hls-eval-plugin/test/testdata/T11.expected.hs b/plugins/hls-eval-plugin/test/testdata/T11.expected.hs index fac41da1cd..eb472f9002 100644 --- a/plugins/hls-eval-plugin/test/testdata/T11.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T11.expected.hs @@ -1,4 +1,4 @@ module T11 where --- >>> :kind! a --- Not in scope: type variable ‘a’ +-- >>> :kind! A +-- Not in scope: type constructor or class ‘A’ diff --git a/plugins/hls-eval-plugin/test/testdata/T11.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T11.ghc92.expected.hs deleted file mode 100644 index 02270516a4..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T11.ghc92.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T11 where - --- >>> :kind! a --- Not in scope: type variable `a' diff --git a/plugins/hls-eval-plugin/test/testdata/T11.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T11.ghc92_expected.hs deleted file mode 100644 index 02270516a4..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T11.ghc92_expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T11 where - --- >>> :kind! a --- Not in scope: type variable `a' diff --git a/plugins/hls-eval-plugin/test/testdata/T11.hs b/plugins/hls-eval-plugin/test/testdata/T11.hs index 724100f3a6..b4dbe83460 100644 --- a/plugins/hls-eval-plugin/test/testdata/T11.hs +++ b/plugins/hls-eval-plugin/test/testdata/T11.hs @@ -1,3 +1,3 @@ module T11 where --- >>> :kind! a +-- >>> :kind! A diff --git a/plugins/hls-eval-plugin/test/testdata/T13.expected.hs b/plugins/hls-eval-plugin/test/testdata/T13.expected.hs index c76a2af295..60d6787d55 100644 --- a/plugins/hls-eval-plugin/test/testdata/T13.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T13.expected.hs @@ -1,4 +1,4 @@ module T13 where --- >>> :kind a --- Not in scope: type variable ‘a’ +-- >>> :kind A +-- Not in scope: type constructor or class ‘A’ diff --git a/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs index f5a6d1655f..60a75bdfdd 100644 --- a/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs @@ -1,4 +1,4 @@ module T13 where --- >>> :kind a --- Not in scope: type variable `a' +-- >>> :kind A +-- Not in scope: type constructor or class `A' diff --git a/plugins/hls-eval-plugin/test/testdata/T13.hs b/plugins/hls-eval-plugin/test/testdata/T13.hs index f8512aae2d..b2f51a5ddc 100644 --- a/plugins/hls-eval-plugin/test/testdata/T13.hs +++ b/plugins/hls-eval-plugin/test/testdata/T13.hs @@ -1,3 +1,3 @@ module T13 where --- >>> :kind a +-- >>> :kind A diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc94.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc94.expected.hs new file mode 100644 index 0000000000..5699e7517e --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc94.expected.hs @@ -0,0 +1,13 @@ +-- Support for property checking +module TProperty where + +-- prop> \(l::[Bool]) -> head l +-- *** Failed! (after 1 test): +-- Exception: +-- Prelude.head: empty list +-- CallStack (from HasCallStack): +-- error, called at libraries/base/GHC/List.hs:1646:3 in base:GHC.List +-- errorEmptyList, called at libraries/base/GHC/List.hs:85:11 in base:GHC.List +-- badHead, called at libraries/base/GHC/List.hs:81:28 in base:GHC.List +-- head, called at :1:27 in interactive:Ghci2 +-- [] diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.windows-ghc94.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.windows-ghc94.expected.hs new file mode 100644 index 0000000000..6c7813d776 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TPropertyError.windows-ghc94.expected.hs @@ -0,0 +1,13 @@ +-- Support for property checking +module TProperty where + +-- prop> \(l::[Bool]) -> head l +-- *** Failed! (after 1 test): +-- Exception: +-- Prelude.head: empty list +-- CallStack (from HasCallStack): +-- error, called at libraries\base\GHC\List.hs:1646:3 in base:GHC.List +-- errorEmptyList, called at libraries\base\GHC\List.hs:85:11 in base:GHC.List +-- badHead, called at libraries\base\GHC\List.hs:81:28 in base:GHC.List +-- head, called at :1:27 in interactive:Ghci2 +-- [] diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index d3c7878629..331eb72d91 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -269,7 +269,11 @@ extractMinimalImports _ _ = return ([], Nothing) mkExplicitEdit :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit mkExplicitEdit pred posMapping (L (locA -> src) imp) explicit -- Explicit import list case +#if MIN_VERSION_ghc (9,5,0) + | ImportDecl {ideclImportList = Just (Exactly, _)} <- imp = +#else | ImportDecl {ideclHiding = Just (False, _)} <- imp = +#endif Nothing | not (isQualifiedImport imp), RealSrcSpan l _ <- src, diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index e7e6c81683..12a0791b6c 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -23,7 +23,7 @@ import Data.Generics (GenericQ, everything, extQ, mkQ) import qualified Data.HashMap.Strict as HashMap import Data.Maybe (isJust, listToMaybe, - maybeToList) + maybeToList, fromMaybe) import Data.Text (Text) import Development.IDE (IdeState, NormalizedFilePath, Pretty (..), Recorder (..), @@ -36,7 +36,8 @@ import Development.IDE.Core.Shake (define, use) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat (HsConDetails (RecCon), HsRecFields (..), LPat, - Outputable, getLoc, unLoc) + Outputable, getLoc, unLoc, + recDotDot) import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns), GhcPass, HsExpr (RecordCon, rcon_flds), @@ -304,7 +305,7 @@ preprocessRecord -> HsRecFields p arg preprocessRecord getName names flds = flds { rec_dotdot = Nothing , rec_flds = rec_flds' } where - no_pun_count = maybe (length (rec_flds flds)) unLoc (rec_dotdot flds) + no_pun_count = fromMaybe (length (rec_flds flds)) (recDotDot flds) -- Field binds of the explicit form (e.g. `{ a = a' }`) should be -- left as is, hence the split. (no_puns, puns) = splitAt no_pun_count (rec_flds flds) diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal index a4d39b0aa8..617f97a1ad 100644 --- a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal +++ b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal @@ -21,6 +21,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Ide.Plugin.Floskell hs-source-dirs: src build-depends: @@ -35,6 +37,8 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.5) + buildable: False type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index f31cd3b93e..3552da3bde 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -23,6 +23,8 @@ source-repository head location: git://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Ide.Plugin.Fourmolu , Ide.Plugin.Fourmolu.Shim @@ -47,6 +49,8 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.5) + buildable: False type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 8db7904c1c..dd358f8334 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE CPP #-} module Ide.Plugin.Fourmolu ( descriptor, @@ -101,7 +102,11 @@ provider recorder plId ideState typ contents fp fo = withIndefiniteProgress titl else do let format fourmoluConfig = bimap (mkError . show) (makeDiffTextEdit contents) +#if MIN_VERSION_fourmolu(0,11,0) + <$> try @OrmoluException (ormolu config fp' contents) +#else <$> try @OrmoluException (ormolu config fp' (T.unpack contents)) +#endif where printerOpts = cfgFilePrinterOpts fourmoluConfig config = diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs index 1e7fade456..150094bd07 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -8,6 +8,8 @@ {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.GADT (descriptor) where +import Control.Monad.Trans.Class +import Control.Monad.IO.Class import Control.Lens ((^.)) import Control.Monad.Except import Data.Aeson (FromJSON, ToJSON, Value (Null), diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index 73901b0c14..fecb8def47 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -13,6 +13,7 @@ module Ide.Plugin.GHC where import Data.Functor ((<&>)) import Data.List.Extra (stripInfix) +import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import Development.IDE import Development.IDE.GHC.Compat @@ -29,7 +30,11 @@ import GHC.Parser.Annotation (AddEpAnn (..), EpAnnComments (EpaComments), EpaLocation (EpaDelta), SrcSpanAnn' (SrcSpanAnn), - spanAsAnchor) + spanAsAnchor, +#if MIN_VERSION_ghc(9,5,0) + TokenLocation(..) +#endif + ) import Language.Haskell.GHC.ExactPrint (showAst) #else import qualified Data.Map.Lazy as Map @@ -94,9 +99,17 @@ h98ToGADTConDecl dataName tyVars ctxt = \case ConDeclH98{..} -> ConDeclGADT con_ext +#if MIN_VERSION_ghc(9,5,0) + (NE.singleton con_name) +#else [con_name] +#endif + #if !MIN_VERSION_ghc(9,2,1) con_forall +#endif +#if MIN_VERSION_ghc(9,5,0) + (L NoTokenLoc HsNormalTok) #endif -- Ignore all existential type variable since GADT not needed implicitTyVars @@ -199,7 +212,8 @@ prettyGADTDecl df decl = adjustDataDecl DataDecl{..} = DataDecl { tcdDExt = adjustWhere tcdDExt , tcdDataDefn = tcdDataDefn - { dd_cons = map adjustCon (dd_cons tcdDataDefn) + { dd_cons = + fmap adjustCon (dd_cons tcdDataDefn) } , .. } diff --git a/plugins/hls-gadt-plugin/test/Main.hs b/plugins/hls-gadt-plugin/test/Main.hs index 5fe112dc40..7460eec245 100644 --- a/plugins/hls-gadt-plugin/test/Main.hs +++ b/plugins/hls-gadt-plugin/test/Main.hs @@ -35,13 +35,13 @@ tests = testGroup "GADT" , runTest "ConstructorContext" "ConstructorContext" 2 0 2 38 , runTest "Context" "Context" 2 0 4 41 , runTest "Pragma" "Pragma" 2 0 3 29 - , onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "Single deriving has different output on ghc9.2+" $ + , onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "Single deriving has different output on ghc9.2+" $ runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14 - , knownBrokenForGhcVersions [GHC92,GHC94] "Single deriving has different output on ghc9.2+" $ + , knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "Single deriving has different output on ghc9.2+" $ runTest "SingleDeriving" "SingleDeriving" 2 0 3 14 - , onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "only ghc-9.2+ enabled GADTs pragma implicitly" $ + , onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "only ghc-9.2+ enabled GADTs pragma implicitly" $ gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False - , knownBrokenForGhcVersions [GHC92,GHC94] "ghc-9.2 has enabled GADTs pragma implicitly" $ + , knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "ghc-9.2 has enabled GADTs pragma implicitly" $ gadtPragmaTest "insert pragma" True ] diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 9a009f160d..fb4f8606f7 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -30,6 +30,8 @@ flag pedantic manual: True library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Ide.Plugin.Hlint hs-source-dirs: src build-depends: @@ -76,6 +78,8 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.5) + buildable: False type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal index e7b8d0c9cd..c1288e6c37 100644 --- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal +++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal @@ -23,6 +23,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Ide.Plugin.Ormolu hs-source-dirs: src build-depends: @@ -40,6 +42,8 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.5) + buildable: False type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index 9e366652a6..944f170468 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -145,7 +145,11 @@ showAstDataHtml a0 = html $ sourceText (SourceText src) = text "SourceText" <+> text src epaAnchor :: EpaLocation -> SDoc +#if MIN_VERSION_ghc(9,5,0) + epaAnchor (EpaSpan r _) = text "EpaSpan" <+> realSrcSpan r +#else epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r +#endif epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs anchorOp :: AnchorOperation -> SDoc diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 21bf27dcd3..a265a1b505 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -472,7 +472,7 @@ modifySmallestDeclWithM :: modifySmallestDeclWithM validSpan f a = do let modifyMatchingDecl [] = pure (DL.empty, Nothing) modifyMatchingDecl (ldecl@(L src _) : rest) = - lift (validSpan $ locA src) >>= \case + TransformT (lift $ validSpan $ locA src) >>= \case True -> do (decs', r) <- f ldecl pure $ (DL.fromList decs' <> DL.fromList rest, Just r) @@ -578,11 +578,18 @@ modifyMgMatchesT' :: r -> (r -> r -> m r) -> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r) +#if MIN_VERSION_ghc(9,5,0) +modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do + (unzip -> (matches', rs)) <- mapM f matches + r' <- TransformT $ lift $ foldM combineResults def rs + pure $ (MG xMg (L locMatches matches'), r') +#else modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do (unzip -> (matches', rs)) <- mapM f matches r' <- lift $ foldM combineResults def rs pure $ (MG xMg (L locMatches matches') originMg, r') #endif +#endif graftSmallestDeclsWithM :: forall a. @@ -697,7 +704,7 @@ annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) - expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered + expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) #elif MIN_VERSION_ghc(9,2,0) expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered @@ -738,7 +745,7 @@ annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) - expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered + expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0 #elif MIN_VERSION_ghc(9,2,0) expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index f307944b73..6e21a129dc 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -106,6 +106,7 @@ import GHC (AddEpAnn (Ad DeltaPos (..), EpAnn (..), EpaLocation (..), + hsmodAnn, LEpaComment) #else import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), @@ -252,9 +253,21 @@ extendImportHandler' ideState ExtendImport {..} mzero isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool -isWantedModule wantedModule Nothing (L _ it@ImportDecl{ideclName, ideclHiding = Just (False, _)}) = +isWantedModule wantedModule Nothing (L _ it@ImportDecl{ ideclName +#if MIN_VERSION_ghc(9,5,0) + , ideclImportList = Just (Exactly, _) +#else + , ideclHiding = Just (False, _) +#endif + }) = not (isQualifiedImport it) && unLoc ideclName == wantedModule -isWantedModule wantedModule (Just qual) (L _ ImportDecl{ideclAs, ideclName, ideclHiding = Just (False, _)}) = +isWantedModule wantedModule (Just qual) (L _ ImportDecl{ ideclAs, ideclName +#if MIN_VERSION_ghc(9,5,0) + , ideclImportList = Just (Exactly, _) +#else + , ideclHiding = Just (False, _) +#endif + }) = unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False @@ -813,15 +826,21 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, -- In the expression: seq "test" seq "test" (traceShow "test") -- In an equation for ‘f’: -- f = seq "test" seq "test" (traceShow "test") +-- | Just [ty, lit] <- matchRegexUnifySpaces _message (pat False False True False) - <|> matchRegexUnifySpaces _message (pat False False False True) - <|> matchRegexUnifySpaces _message (pat False False False False) - = codeEdit ty lit (makeAnnotatedLit ty lit) + <|> matchRegexUnifySpaces _message (pat False False False True) + <|> matchRegexUnifySpaces _message (pat False False False False) + + = codeEdit _range ty lit (makeAnnotatedLit ty lit) | Just source <- sourceOpt - , Just [ty, lit] <- matchRegexUnifySpaces _message (pat True True False False) - = let lit' = makeAnnotatedLit ty lit; - tir = textInRange _range source - in codeEdit ty lit (T.replace lit lit' tir) + , Just [ty, lit, srcspan] <- matchRegexUnifySpaces _message (pat True True False False) + , range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of + [s] -> let x = realSrcSpanToRange s + in x{_end = (_end x){_character = succ (_character (_end x))}} + _ -> error "bug in srcspan parser" + = let lit' = makeAnnotatedLit ty lit; + tir = textInRange range source + in codeEdit range ty lit (T.replace lit lit' tir) | otherwise = [] where makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")" @@ -829,10 +848,10 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable " , ".*to type ‘([^ ]+)’ " , "in the following constraint" - , if multiple then "s" else "" + , if multiple then "s" else " " , ".*arising from the literal ‘(.+)’" , if inArg then ".+In the.+argument" else "" - , if at then ".+at" else "" + , if at then ".+at ([^ ]*)" else "" , if inExpr then ".+In the expression" else "" , ".+In the expression" ] @@ -842,14 +861,14 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, , " to type ‘([^ ]+)’ " , ".*arising from the literal ‘(.+)’" , if inArg then ".+In the.+argument" else "" - , if at then ".+at" else "" + , if at then ".+at ([^ ]*)" else "" , if inExpr then ".+In the expression" else "" , ".+In the expression" ] #endif - codeEdit ty lit replacement = + codeEdit range ty lit replacement = let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’" - edits = [TextEdit _range replacement] + edits = [TextEdit range replacement] in [( title, edits )] -- | GHC strips out backticks in case of infix functions as well as single quote @@ -954,7 +973,7 @@ suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Cod suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message - "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$" + "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)." = suggestions hsmodImports binding mod srcspan | Just (binding, mod_srcspan) <- matchRegExMultipleImports _message @@ -1119,10 +1138,17 @@ occursUnqualified symbol ImportDecl{..} | isNothing ideclAs = Just False /= -- I don't find this particularly comprehensible, -- but HLint suggested me to do so... +#if MIN_VERSION_ghc(9,5,0) + (ideclImportList <&> \(isHiding, L _ ents) -> + let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents + in (isHiding == EverythingBut) && not occurs || (isHiding == Exactly) && occurs + ) +#else (ideclHiding <&> \(isHiding, L _ ents) -> let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents in isHiding && not occurs || not isHiding && occurs ) +#endif occursUnqualified _ _ = False symbolOccursIn :: T.Text -> IE GhcPs -> Bool @@ -1197,11 +1223,20 @@ suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} where findMissingConstraint :: T.Text -> Maybe T.Text findMissingConstraint t = - let regex = "(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement - regexImplicitParams = "Could not deduce: (\\?.+) arising from a use of" + let -- The regex below can be tested at: + -- https://regex101.com/r/dfSivJ/1 + regex = "(No instance for|Could not deduce):? (\\((.+)\\)|‘(.+)’|.+) arising from" -- a use of / a do statement + match = matchRegexUnifySpaces t regex - matchImplicitParams = matchRegexUnifySpaces t regexImplicitParams - in match <|> matchImplicitParams <&> last + + -- For a string like: + -- "Could not deduce: ?a::() arising from" + -- The `matchRegexUnifySpaces` function returns two empty match + -- groups at the end of the list. It's not clear why this is the + -- case, so we select the last non-empty match group. + getCorrectGroup = last . filter (/="") + + in getCorrectGroup <$> match -- | Suggests a constraint for an instance declaration for which a constraint is missing. suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] @@ -1557,7 +1592,11 @@ findPositionAfterModuleName ps hsmodName' = do -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. whereKeywordLineOffset :: Maybe Int #if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + whereKeywordLineOffset = case hsmodAnn hsmodExt of +#else whereKeywordLineOffset = case hsmodAnn of +#endif EpAnn _ annsModule _ -> do -- Find the first 'where' whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule @@ -1567,7 +1606,12 @@ findPositionAfterModuleName ps hsmodName' = do filterWhere _ = Nothing epaLocationToLine :: EpaLocation -> Maybe Int - epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp +#if MIN_VERSION_ghc(9,5,0) + epaLocationToLine (EpaSpan sp _) +#else + epaLocationToLine (EpaSpan sp) +#endif + = Just . srcLocLine . realSrcSpanEnd $ sp epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments -- 'priorComments' contains the comments right before the current EpaLocation -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and @@ -1808,7 +1852,13 @@ textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCo -- | Returns the ranges for a binding in an import declaration rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range] -rangesForBindingImport ImportDecl{ideclHiding = Just (False, L _ lies)} b = +rangesForBindingImport ImportDecl{ +#if MIN_VERSION_ghc(9,5,0) + ideclImportList = Just (Exactly, L _ lies) +#else + ideclHiding = Just (False, L _ lies) +#endif + } b = concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies where b' = wrapOperatorInParens b diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index afc1b9b5e2..275c26c389 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -311,7 +311,7 @@ liftParseAST df s = case parseAST df "" s of #else Right x -> pure (makeDeltaAst x) #endif - Left _ -> lift $ Left $ "No parse: " <> s + Left _ -> TransformT $ lift $ Left $ "No parse: " <> s #if !MIN_VERSION_ghc(9,2,0) lookupAnn :: (Data a, Monad m) @@ -344,7 +344,7 @@ lastMaybe other = Just $ last other liftMaybe :: String -> Maybe a -> TransformT (Either String) a liftMaybe _ (Just x) = return x -liftMaybe s _ = lift $ Left s +liftMaybe s _ = TransformT $ lift $ Left s ------------------------------------------------------------------------------ extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite @@ -376,7 +376,11 @@ extendImportTopLevel :: LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportTopLevel thing (L l it@ImportDecl{..}) +#if MIN_VERSION_ghc(9,5,0) + | Just (hide, L l' lies) <- ideclImportList +#else | Just (hide, L l' lies) <- ideclHiding +#endif , hasSibling <- not $ null lies = do src <- uniqueSrcSpanT top <- uniqueSrcSpanT @@ -385,13 +389,17 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) printOutputable (occName (unLoc rdr)) `elem` map (printOutputable @OccName) (listify (const True) lies) when alreadyImported $ - lift (Left $ thing <> " already imported") + TransformT $ lift (Left $ thing <> " already imported") - let lie = reLocA $ L src $ IEName rdr + let lie = reLocA $ L src $ IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + rdr x = reLocA $ L top $ IEVar noExtField lie if x `elem` lies - then lift (Left $ thing <> " already imported") + then TransformT $ lift (Left $ thing <> " already imported") else do #if !MIN_VERSION_ghc(9,2,0) anns <- getAnnsT @@ -416,9 +424,13 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} #else let lies' = addCommaInImportList lies x +#if MIN_VERSION_ghc(9,5,0) + return $ L l it{ideclImportList = Just (hide, L l' lies')} +#else return $ L l it{ideclHiding = Just (hide, L l' lies')} #endif -extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list" +#endif +extendImportTopLevel _ _ = TransformT $ lift $ Left "Unable to extend the import list" wildCardSymbol :: String wildCardSymbol = ".." @@ -447,16 +459,24 @@ extendImportViaParent :: LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportViaParent df parent child (L l it@ImportDecl{..}) +#if MIN_VERSION_ghc(9,5,0) + | Just (hide, L l' lies) <- ideclImportList = go hide l' [] lies +#else | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies +#endif where go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs) - | parent == unIEWrappedName ie = lift . Left $ child <> " already included in " <> parent <> " imports" + | parent == unIEWrappedName ie = TransformT $ lift . Left $ child <> " already included in " <> parent <> " imports" go hide l' pre (lAbs@(L ll' (IEThingAbs _ absIE@(L _ ie))) : xs) -- ThingAbs ie => ThingWith ie child | parent == unIEWrappedName ie = do srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child - childLIE = reLocA $ L srcChild $ IEName childRdr + childLIE = reLocA $ L srcChild $ IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + childRdr #if !MIN_VERSION_ghc(9,2,0) x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] [] -- take anns from ThingAbs, and attach parens to it @@ -465,7 +485,13 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #else x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE] #endif + +#if MIN_VERSION_ghc(9,5,0) + return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} +#else return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} +#endif + #if !MIN_VERSION_ghc(9,2,0) go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs) #else @@ -475,7 +501,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) | parent == unIEWrappedName ie , child == wildCardSymbol = do #if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + let it' = it{ideclImportList = Just (hide, lies)} +#else let it' = it{ideclHiding = Just (hide, lies)} +#endif thing = IEThingWith newl twIE (IEWildcard 2) [] newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' lies = L l' $ reverse pre ++ [L l'' thing] ++ xs @@ -497,16 +527,24 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) printOutputable (occName (unLoc childRdr)) `elem` map (printOutputable @OccName) (listify (const True) lies') when alreadyImported $ - lift (Left $ child <> " already included in " <> parent <> " imports") + TransformT $ lift (Left $ child <> " already included in " <> parent <> " imports") - let childLIE = reLocA $ L srcChild $ IEName childRdr + let childLIE = reLocA $ L srcChild $ IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + childRdr #if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (last lies') addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} +#else +#if MIN_VERSION_ghc(9,5,0) + let it' = it{ideclImportList = Just (hide, lies)} #else let it' = it{ideclHiding = Just (hide, lies)} +#endif lies = L l' $ reverse pre ++ [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs fixLast = if hasSibling then first addComma else id @@ -528,11 +566,20 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr) childLIE = reLocA $ L srcChild $ IEName childRdr #else - let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr') + let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' + else IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + parentRdr') parentRdr' = modifyAnns parentRdr $ \case it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1, nann_close = epl 0} other -> other - childLIE = reLocA $ L srcChild $ IEName childRdr + childLIE = reLocA $ L srcChild $ IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + childRdr #endif #if !MIN_VERSION_ghc(9,2,0) x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] @@ -554,8 +601,12 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) lies' = addCommaInImportList (reverse pre) x #endif +#if MIN_VERSION_ghc(9,5,0) + return $ L l it{ideclImportList = Just (hide, L l' lies')} +#else return $ L l it{ideclHiding = Just (hide, L l' lies')} -extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent" +#endif +extendImportViaParent _ _ _ _ = TransformT $ lift $ Left "Unable to extend the import list via parent" #if MIN_VERSION_ghc(9,2,0) -- Add an item in an import list, taking care of adding comma if needed. @@ -592,7 +643,11 @@ addCommaInImportList lies x = fixLast = over _last (first (if existingTrailingComma then id else addComma)) #endif +#if MIN_VERSION_ghc(9,5,0) +unIEWrappedName :: IEWrappedName GhcPs -> String +#else unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String +#endif unIEWrappedName (occName -> occ) = T.unpack $ printOutputable $ parenSymOcc occ (ppr occ) hasParen :: String -> Bool @@ -615,10 +670,17 @@ unqalDP c paren = hideSymbol :: String -> LImportDecl GhcPs -> Rewrite hideSymbol symbol lidecl@(L loc ImportDecl{..}) = +#if MIN_VERSION_ghc(9,5,0) + case ideclImportList of + Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing + Just (EverythingBut, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) + Just (Exactly, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports +#else case ideclHiding of Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports +#endif hideSymbol _ (L _ (XImportDecl _)) = error "cannot happen" @@ -655,7 +717,11 @@ extendHiding symbol (L l idecls) mlies df = do #if MIN_VERSION_ghc(9,2,0) rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr) #endif - let lie = reLocA $ L src $ IEName rdr + let lie = reLocA $ L src $ IEName +#if MIN_VERSION_ghc(9,5,0) + noExtField +#endif + rdr x = reLocA $ L top $ IEVar noExtField lie #if MIN_VERSION_ghc(9,2,0) x <- pure $ if hasSibling then first addComma x else x @@ -682,7 +748,11 @@ extendHiding symbol (L l idecls) mlies df = do else forM_ mlies $ \lies0 -> do transferAnn lies0 singleHide id #endif +#if MIN_VERSION_ghc(9,5,0) + return $ L l idecls{ideclImportList = Just (EverythingBut, L l' $ x : lies)} +#else return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)} +#endif where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc @@ -701,7 +771,11 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do lidecl' = L l $ idecl +#if MIN_VERSION_ghc(9,5,0) + { ideclImportList = Just (Exactly, edited) +#else { ideclHiding = Just (False, edited) +#endif } #if !MIN_VERSION_ghc(9,2,0) -- avoid import A (foo,) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index cdb4086133..82bb01d9c8 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -10,7 +10,7 @@ import qualified Data.Text as T import Language.LSP.Types #else import Control.Monad (join) -import Control.Monad.Except (lift) +import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T @@ -34,7 +34,7 @@ import GHC.Hs (IsUnicodeSyntax (..) import GHC.Types.SrcLoc (generatedSrcSpan) import Ide.PluginUtils (makeDiffTextEdit, responseError) -import Language.Haskell.GHC.ExactPrint (TransformT, +import Language.Haskell.GHC.ExactPrint (TransformT(..), noAnnSrcSpanDP1, runTransformT) import Language.Haskell.GHC.ExactPrint.Transform (d1) @@ -85,10 +85,10 @@ addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) = -- => (`foo bar baz new_pat = 1`, Just ("foo", 2)) appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either ResponseError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int)) appendFinalPatToMatches name = \case - (L locDecl (ValD xVal (FunBind xFunBind idFunBind mg coreFunBind))) -> do + (L locDecl (ValD xVal fun@FunBind{fun_matches=mg,fun_id = idFunBind})) -> do (mg', numPatsMay) <- modifyMgMatchesT' mg (pure . second Just . addArgToMatch name) Nothing combineMatchNumPats - numPats <- lift $ maybeToEither (responseError "Unexpected empty match group in HsDecl") numPatsMay - let decl' = L locDecl (ValD xVal (FunBind xFunBind idFunBind mg' coreFunBind)) + numPats <- TransformT $ lift $ maybeToEither (responseError "Unexpected empty match group in HsDecl") numPatsMay + let decl' = L locDecl (ValD xVal fun{fun_matches=mg'}) pure (decl', Just (idFunBind, numPats)) decl -> pure (decl, Nothing) where diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 499e529500..2200d29b3c 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2416,8 +2416,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\"" ]) - , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $ - testSession "add default type to satisfy two constraints" $ + , testSession "add default type to satisfy two constraints" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2441,8 +2440,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a" ]) - , knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $ - testSession "add default type to satisfy two constraints with duplicate literals" $ + , testSession "add default type to satisfy two constraints with duplicate literals" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" diff --git a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs index fdffb73ff2..b448839898 100644 --- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs +++ b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs @@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} module Ide.Plugin.RefineImports (descriptor, Log(..)) where @@ -212,7 +213,11 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm :: LImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo]) +#if MIN_VERSION_ghc(9,5,0) + filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)}) avails = +#else filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)}) avails = +#endif let importedNames = S.fromList $ map (ieName . unLoc) names res = flip Map.filter avails $ \a -> any (`S.member` importedNames) @@ -234,10 +239,18 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm -> LImportDecl GhcRn constructImport i@(L lim id@ImportDecl +#if MIN_VERSION_ghc(9,5,0) + {ideclName = L _ mn, ideclImportList = Just (hiding, L _ names)}) +#else {ideclName = L _ mn, ideclHiding = Just (hiding, L _ names)}) +#endif (newModuleName, avails) = L lim id { ideclName = noLocA newModuleName +#if MIN_VERSION_ghc(9,5,0) + , ideclImportList = Just (hiding, noLocA newNames) +#else , ideclHiding = Just (hiding, noLocA newNames) +#endif } where newNames = filter (\n -> any (n `containsAvail`) avails) names constructImport lim _ = lim diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index b45049e377..e5127c9567 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -503,7 +503,11 @@ suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) = ] | L (locA -> l) r <- rds_rules, pos `isInsideSrcSpan` l, +#if MIN_VERSION_ghc(9,5,0) + let HsRule {rd_name = L _ rn} = r, +#else let HsRule {rd_name = L _ (_, rn)} = r, +#endif let ruleName = unpackFS rn ] where @@ -773,7 +777,13 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} ideclImplicit = False ideclHiding = Nothing ideclSourceSrc = NoSourceText -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + ideclExt = GHCGHC.XImportDeclPass + { ideclAnn = GHCGHC.EpAnnNotUsed + , ideclSourceText = ideclSourceSrc + , ideclImplicit = ideclImplicit + } +#elif MIN_VERSION_ghc(9,2,0) ideclExt = GHCGHC.EpAnnNotUsed #else ideclExt = GHC.noExtField diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 645a723807..6cd0b9ab7a 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -51,6 +51,7 @@ import Development.IDE.GHC.Compat as Compat hiding (getLoc) import Development.IDE.GHC.Compat.ExactPrint import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint +import Language.Haskell.GHC.ExactPrint.Transform (TransformT(TransformT)) #if MIN_VERSION_ghc(9,4,1) import GHC.Data.Bag (Bag) #endif @@ -295,24 +296,56 @@ data SpliceClass where OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass IsHsDecl :: SpliceClass +#if MIN_VERSION_ghc(9,5,0) +data HsSpliceCompat pass + = UntypedSplice (HsUntypedSplice pass) + | TypedSplice (LHsExpr pass) +#endif + + class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where type SpliceOf ast :: Kinds.Type -> Kinds.Type - type SpliceOf ast = HsSplice matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs) expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars) instance HasSplice AnnListItem HsExpr where +#if MIN_VERSION_ghc(9,5,0) + type SpliceOf HsExpr = HsSpliceCompat + matchSplice _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl) + matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl) +#else + type SpliceOf HsExpr = HsSplice matchSplice _ (HsSpliceE _ spl) = Just spl +#endif matchSplice _ _ = Nothing +#if MIN_VERSION_ghc(9,5,0) + expandSplice _ (UntypedSplice e) = fmap (first Right) $ rnUntypedSpliceExpr e + expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice e +#else expandSplice _ = fmap (first Right) . rnSpliceExpr +#endif instance HasSplice AnnListItem Pat where +#if MIN_VERSION_ghc(9,5,0) + type SpliceOf Pat = HsUntypedSplice +#else + type SpliceOf Pat = HsSplice +#endif matchSplice _ (SplicePat _ spl) = Just spl matchSplice _ _ = Nothing - expandSplice _ = rnSplicePat + expandSplice _ = +#if MIN_VERSION_ghc(9,5,0) + fmap (first (Left . unLoc . utsplice_result . snd )) . +#endif + rnSplicePat instance HasSplice AnnListItem HsType where +#if MIN_VERSION_ghc(9,5,0) + type SpliceOf HsType = HsUntypedSplice +#else + type SpliceOf HsType = HsSplice +#endif matchSplice _ (HsSpliceTy _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = fmap (first Right) . rnSpliceType @@ -349,7 +382,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- eitherM (fail . show) pure - $ lift + $ TransformT $ lift ( lift $ Util.try @_ @SomeException $ (fst <$> rnTopSpliceDecls spl) @@ -362,7 +395,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- eitherM (fail . show) pure - $ lift + $ TransformT $ lift ( lift $ Util.try @_ @SomeException $ (fst <$> expandSplice astP spl) @@ -401,10 +434,15 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String showBag = show . fmap (fmap toDiagnosticMessage) -toDiagnosticMessage :: Error.Diagnostic a => a -> Error.DiagnosticMessage +toDiagnosticMessage :: forall a. Error.Diagnostic a => a -> Error.DiagnosticMessage toDiagnosticMessage message = Error.DiagnosticMessage - { diagMessage = Error.diagnosticMessage message + { diagMessage = Error.diagnosticMessage +#if MIN_VERSION_ghc(9,5,0) + (Error.defaultDiagnosticOpts @a) +#endif + message + , diagReason = Error.diagnosticReason message , diagHints = Error.diagnosticHints message } @@ -480,7 +518,12 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ (L (AsSrcSpan l@(RealSrcSpan spLoc _)) expr :: LHsExpr GhcPs) | spanIsRelevant l -> case expr of +#if MIN_VERSION_ghc(9,5,0) + HsTypedSplice{} -> Here (spLoc, Expr) + HsUntypedSplice{} -> Here (spLoc, Expr) +#else HsSpliceE {} -> Here (spLoc, Expr) +#endif _ -> Continue _ -> Stop ) diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs index 492e68100c..d72fc8e45f 100644 --- a/plugins/hls-splice-plugin/test/Main.hs +++ b/plugins/hls-splice-plugin/test/Main.hs @@ -57,8 +57,13 @@ tests = testGroup "splice" , goldenTest "TQQTypeTypeError" Inplace 8 28 , goldenTest "TSimpleDecl" Inplace 8 1 , goldenTest "TQQDecl" Inplace 5 1 - , goldenTestWithEdit "TTypeKindError" Inplace 7 9 - , goldenTestWithEdit "TDeclKindError" Inplace 8 1 + , goldenTestWithEdit "TTypeKindError" ( + if ghcVersion >= GHC96 then + "96-expected" + else + "expected" + ) Inplace 7 9 + , goldenTestWithEdit "TDeclKindError" "expected" Inplace 8 1 ] goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree @@ -74,9 +79,9 @@ goldenTest fp tc line col = void $ skipManyTill anyMessage (message SWorkspaceApplyEdit) _ -> liftIO $ assertFailure "No CodeAction detected" -goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree -goldenTestWithEdit fp tc line col = - goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do +goldenTestWithEdit :: FilePath -> FilePath -> ExpandStyle -> Int -> Int -> TestTree +goldenTestWithEdit fp expect tc line col = + goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp expect "hs" $ \doc -> do orig <- documentContents doc let lns = T.lines orig diff --git a/plugins/hls-splice-plugin/test/testdata/TTypeKindError.96-expected.hs b/plugins/hls-splice-plugin/test/testdata/TTypeKindError.96-expected.hs new file mode 100644 index 0000000000..101e12e402 --- /dev/null +++ b/plugins/hls-splice-plugin/test/testdata/TTypeKindError.96-expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module TTypeKindError where +import Language.Haskell.TH ( numTyLit, litT ) +import Data.Proxy ( Proxy ) + +main :: 42 +main = return () diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal index c494e44eff..5253db3da7 100644 --- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal +++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal @@ -20,6 +20,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Ide.Plugin.StylishHaskell hs-source-dirs: src build-depends: @@ -37,6 +39,8 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.5) + buildable: False type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/shake-bench/shake-bench.cabal b/shake-bench/shake-bench.cabal index 0f3690ffe2..fafccc20c8 100644 --- a/shake-bench/shake-bench.cabal +++ b/shake-bench/shake-bench.cabal @@ -16,6 +16,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.5) + buildable: False exposed-modules: Development.Benchmark.Rules hs-source-dirs: src build-depends: diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 4aeccc1549..f131e45d60 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -7,6 +7,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {- | diff --git a/stack-lts19.yaml b/stack-lts19.yaml index 8b964d8dea..ec0b29b52a 100644 --- a/stack-lts19.yaml +++ b/stack-lts19.yaml @@ -49,7 +49,7 @@ extra-deps: - ghc-lib-9.2.4.20220729 - ghc-lib-parser-9.2.4.20220729 - ghc-lib-parser-ex-9.2.0.4 -- hiedb-0.4.2.0 +- hiedb-0.4.3.0 - hlint-3.4 - implicit-hie-0.1.2.7@sha256:82bbbb1a8c05f99c8af3c16ac53e80c8648d8bf047b25ed5ce45a135bd736907,3122 - implicit-hie-cradle-0.5.0.0@sha256:4276f60f3a59bc22df03fd918f73bca9f777de9568f85e3a8be8bd7566234a59,2368 diff --git a/stack.yaml b/stack.yaml index 5ffd76d192..ff511b03f9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,7 +41,7 @@ extra-deps: # needed for tests of hls-cabal-fmt-plugin - cabal-fmt-0.1.6@sha256:54041d50c8148c32d1e0a67aef7edeebac50ae33571bef22312f6815908eac19,3626 - floskell-0.10.6@sha256:e77d194189e8540abe2ace2c7cb8efafc747ca35881a2fefcbd2d40a1292e036,3819 -- hiedb-0.4.2.0 +- hiedb-0.4.3.0 - implicit-hie-0.1.2.7@sha256:82bbbb1a8c05f99c8af3c16ac53e80c8648d8bf047b25ed5ce45a135bd736907,3122 - implicit-hie-cradle-0.5.0.0@sha256:4276f60f3a59bc22df03fd918f73bca9f777de9568f85e3a8be8bd7566234a59,2368 - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 475f34da3a..b3fe0fc2a3 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -114,7 +114,10 @@ importQualifiedTests = testGroup "import qualified prefix suggestions" [ sendConfigurationChanged (toJSON config) (diag:_) <- waitForDiagnosticsFrom doc - liftIO $ diag ^. L.message @?= "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." + liftIO $ diag ^. L.message @?= + if ghcVersion >= GHC96 + then "Variable not in scope: Control.when :: Bool -> IO () -> IO ()\nNB: no module named ‘Control’ is imported." + else "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." actionsOrCommands <- getAllCodeActions doc let actns = map fromAction actionsOrCommands @@ -123,7 +126,7 @@ importQualifiedTests = testGroup "import qualified prefix suggestions" [ importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedSuggestion] liftIO $ do dontExpectCodeAction actionsOrCommands ["import Control.Monad (when)"] - length actns >= 10 @? "There are some actions" + length actns >= 5 @? "There are some actions" executeCodeAction importControlMonadQualified @@ -140,7 +143,10 @@ importQualifiedPostTests = testGroup "import qualified postfix suggestions" [ sendConfigurationChanged (toJSON config) (diag:_) <- waitForDiagnosticsFrom doc - liftIO $ diag ^. L.message @?= "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." + liftIO $ diag ^. L.message @?= + if ghcVersion >= GHC96 + then "Variable not in scope: Control.when :: Bool -> IO () -> IO ()\nNB: no module named ‘Control’ is imported." + else "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported." actionsOrCommands <- getAllCodeActions doc let actns = map fromAction actionsOrCommands @@ -149,7 +155,7 @@ importQualifiedPostTests = testGroup "import qualified postfix suggestions" [ importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedPostSuggestion] liftIO $ do dontExpectCodeAction actionsOrCommands ["import qualified Control.Monad as Control", "import Control.Monad (when)"] - length actns >= 10 @? "There are some actions" + length actns >= 5 @? "There are some actions" executeCodeAction importControlMonadQualified @@ -314,7 +320,7 @@ typedHoleTests = testGroup "typed hole code actions" [ , "foo x = maxBound" ] - , knownBrokenForGhcVersions [GHC92, GHC94] "The wingman plugin doesn't yet compile in GHC92/GHC94" $ + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "The wingman plugin doesn't yet compile in GHC92/GHC94" $ testCase "doesn't work when wingman is active" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell" @@ -349,7 +355,7 @@ typedHoleTests = testGroup "typed hole code actions" [ , " stuff (A a) = A (a + 1)" ] - , knownBrokenForGhcVersions [GHC92, GHC94] "The wingman plugin doesn't yet compile in GHC92/GHC94" $ + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "The wingman plugin doesn't yet compile in GHC92/GHC94" $ testCase "doesnt show more suggestions when wingman is active" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles2.hs" "haskell"