haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-09-17 11:47:09 +03:00
Code Issues Projects Releases Wiki Activity

Update refactor/splice/hlint/fourmolu/retrie/gadt plugin for GHC 9.4 (#3317)

Browse Source 
* Set buildable on GHC 9.4

* Start work on GHC 9.4 compat

* Use patched `retrie`

* update retrie with github address. circumvent nix-prefetch-url.

* handle ExactPrint

* fix ghc 9.0 env.

* unwrap big CPP conditional for GHC 9.4

* GHC 9.4 buildable by disabling a few suggest.. functions

* enable disabled suggest...!

* hls-fourmolu-plugin is buildable

* hls-splice-plugin is buildable

* hls-hlint-plugin is buildable

* Enable plugins on GHC 9.4

* Add fourmolu for GHC 9.4

* fourmolu tweawk

* Fix `hls-hlint-plugin` build

- Build against GHC 9.4 API
- Increase upper bound on `hlint`

* Fix build of `hls-splice-plugin`

* annotation on close parenthesis. still need more work.

* found where closing parenthesis were missing

* examine internal annotation information.

* make use of makeDeltaAst. This fixes most of test failures in GHC 9.4

* remove dead code

* update apply-refact and hlint deps

* temporarily comment out hls-fourmolu-plugin.

* comment out build-tool-depends. then hls-fourmolu-plugin build succeeds with cabal v2-build

* remove unused fourmolu flake inputs

* fix ghc 9.0 build again.

* hlint and fourmolu for GHC 9.2!

* fix mistakenly overriden nix exp.

* remove unused hlint-3.3.6

* Fix CPP in hls-refactor-plugin

* Fix build error in hls-refactor-plugin

* Fix import

* Use `showErrors` instead of `showBag`

* fix initialization test error in refactor plugin.

* alternateNumberFormat and explicitFixity don't build on GHC 9.4

* force demoteIfDefer = id in typecheckModule for GHC 9.4.

* ignore tests which were already ignored with GHC 9.2

* fix extractDoesNotExportModuleName for GHC 9.4 by adjusting regex match

* use makeDeltaAst in removeRedundantConstraints

* fix addTypeAnnotationsToLiteralsTest

* Revert "alternateNumberFormat and explicitFixity don't build on GHC 9.4"

This reverts commit 4903092780031fb400b28f1e9ce696f1057855d8.

* Update flake lockfile

* Use upstream `retrie`

* Use upstream `retrie`

* Update lockfile

* Use upstream fourmolu

* fix arrow annotation on ghc 9.4

* fix flake.nix issue

* revert demoteIfDefer change for GHC 9.4.

* fix hls-splice-plugin build on GHC 9.0.2

* disable tracy on darwin.

* disable fourmolu plugin and ekg-json for now.

* fourmolu update to 0.10.1.0

* build fix for hls-refactor-plugin after merge

* update index-state.

* downgrade fourmolu to 0.9 for ghc 9.2 and 9.0

* remove unnecessary problematic Cabal-syntax dependency.

* update Cabal for ormolu in ghc 9.0 nix env.

* use custom apply-refact for now for both ghc 9.2 and 9.4

* added ghc >= 9.2 condition

* fix fourmolu with -f-fixity-th in nix env

* limit implicit-hie < 0.1.3

* add fourmolu back to build-tools-depends

* mark GHC92-failing tests to be failed on GHC 9.4

* ci failure test

* bump nix file.

* disable cachix action

* further comment out

* revive cachix action.

* remove commented-out

* fix hls-cabal-plugin by removing Cabal-syntax.
note that this is an opposite to #3383, to prioritize CI fix first.

* limit implicit-hie < 0.1.3

* added a small comment and link to the issue.

* put implicit-hie to ghcide dep

* update apply-refact rev

* use apply-refact-0.11.0.0 on hackage.

* 9.4 support for gadt and retrie plugins

Co-authored-by: Ian-Woo Kim <ianwookim@gmail.com>
Co-authored-by: Gabriella Gonzalez <gabriella@mercury.com>
Co-authored-by: Zubin Duggal <zubin.duggal@gmail.com>
This commit is contained in:
Rebecca Turner 2022-12-21 07:32:31 -05:00 committed by GitHub
parent 6e4612dc42
commit 686fa1aa0e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
27 changed files with 438 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
cabal.project
View File

@ -51,8 +51,7 @@ package *
write-ghc-environment-files: never
index-state: 2022-12-13T21:00:15Z
index-state: 2022-12-19T19:08:33Z
constraints:
-- For GHC 9.4, older versions of entropy fail to build on Windows
@ -66,7 +65,8 @@ constraints:
-- https://github.com/ndmitchell/hlint/issues/1376
hlint +ghc-lib,
ghc-lib-parser-ex -auto,
stylish-haskell +ghc-lib
stylish-haskell +ghc-lib,
fourmolu -fixity-th
-- 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

13
configuration-ghc-90.nix
View File

@ -18,15 +18,14 @@ let
# https://github.com/nikita-volkov/ptr-poker/issues/11
ptr-poker = hself.callCabal2nix "ptr-poker" inputs.ptr-poker { };
ghc-lib = hself.ghc-lib_9_2_4_20220729;
ghc-lib-parser = hself.ghc-lib-parser_9_2_4_20220729;
ghc-lib = hself.ghc-lib_9_2_5_20221107;
ghc-lib-parser = hself.ghc-lib-parser_9_2_5_20221107;
ghc-lib-parser-ex = hself.ghc-lib-parser-ex_9_2_1_1;
Cabal = hself.Cabal_3_6_3_0;
ormolu = hself.ormolu_0_5_0_1;
# Hlint is still broken
hlint = doJailbreak (hself.callCabal2nix "hlint" inputs.hlint-34 { });
fourmolu = hself.fourmolu_0_9_0_0;
hlint = appendConfigureFlag (hself.callCabal2nix "hlint" inputs.hlint-341 {}) "-fghc-lib";
hls-hlint-plugin = hself.callCabal2nixWithOptions "hls-hlint-plugin"
./plugins/hls-hlint-plugin
@ -37,6 +36,10 @@ let
hself.callCabal2nixWithOptions "haskell-language-server" ./.
(pkgs.lib.concatStringsSep " " [ "-f-brittany" "-f-stylishhaskell" ])
{ };
retrie = hself.retrie_1_1_0_0;
apply-refact = hself.apply-refact_0_9_3_0;
});
in {
inherit disabledPlugins;

8
configuration-ghc-92.nix
View File

@ -2,7 +2,6 @@
let
disabledPlugins = [
"hls-hlint-plugin"
# 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.
@ -24,8 +23,10 @@ let
# https://github.com/nikita-volkov/ptr-poker/issues/11
ptr-poker = hself.callCabal2nix "ptr-poker" inputs.ptr-poker { };
# Hlint is still broken
hlint = doJailbreak (hself.callCabal2nix "hlint" inputs.hlint { });
ghc-exactprint =
hself.callCabal2nix "ghc-exactprint" inputs.ghc-exactprint-150 { };
fourmolu = hself.fourmolu_0_9_0_0;
hlint = appendConfigureFlag (hself.callCabal2nix "hlint" inputs.hlint-341 {}) "-fghc-lib";
stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-fghc-lib";
@ -33,6 +34,7 @@ let
haskell-language-server =
hself.callCabal2nixWithOptions "haskell-language-server" ./.
(pkgs.lib.concatStringsSep " " [ "-fpedantic" "-f-hlint" ]) { };
});
in {
inherit disabledPlugins;

5
configuration-ghc-94.nix
View File

@ -2,7 +2,6 @@
let
disabledPlugins = [
"hls-hlint-plugin"
# 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.
@ -26,8 +25,7 @@ let
ghc-exactprint =
hself.callCabal2nix "ghc-exactprint" inputs.ghc-exactprint-160 { };
# Hlint is still broken
hlint = doJailbreak (hself.callCabal2nix "hlint" inputs.hlint { });
hlint = hsuper.callCabal2nix "hlint" inputs.hlint-35 {};
stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-fghc-lib";
@ -35,6 +33,7 @@ let
haskell-language-server =
hself.callCabal2nixWithOptions "haskell-language-server" ./.
(pkgs.lib.concatStringsSep " " [ "-fpedantic" "-f-hlint" ]) { };
});
in {
inherit disabledPlugins;

157
flake.lock
View File

@ -1,13 +1,25 @@
{
"nodes": {
"aeson-1520": {
"flake": false,
"locked": {
"narHash": "sha256-btKp7CTOgC0wT33lROffARW9qr1jx9oKE5EWydaR52c=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/aeson-1.5.2.0/aeson-1.5.2.0.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/aeson-1.5.2.0/aeson-1.5.2.0.tar.gz"
}
},
"all-cabal-hashes-unpacked": {
"flake": false,
"locked": {
"lastModified": 1668997806,
"narHash": "sha256-HRTQuIO/MxV5OcbCNsHSCeULa7KAjxIBQk5sAVFzrKk=",
"lastModified": 1670865018,
"narHash": "sha256-ygmGi0Y2So/DS74PEtBw+ozUoSiN2NM8D8OpjJxwNLc=",
"owner": "commercialhaskell",
"repo": "all-cabal-hashes",
"rev": "934c06ca91eb6ceca8a7c484dfc2862e955489f8",
"rev": "dbe1f3f215709c53df234197497cf9a5cc1d95a7",
"type": "github"
},
"original": {
@ -17,6 +29,54 @@
"type": "github"
}
},
"apply-refact": {
"flake": false,
"locked": {
"narHash": "sha256-cK+rsko/aydlvr7di9XS9XEP9tq3SwFWTRrwYrhfCLs=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/apply-refact-0.11.0.0/apply-refact-0.11.0.0.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/apply-refact-0.11.0.0/apply-refact-0.11.0.0.tar.gz"
}
},
"apply-refact-0930": {
"flake": false,
"locked": {
"narHash": "sha256-EosZM++NRncMEr1KM+UIEjGivknqWFvwpTa6kLgK2Mk=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/apply-refact-0.9.3.0/apply-refact-0.9.3.0.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/apply-refact-0.9.3.0/apply-refact-0.9.3.0.tar.gz"
}
},
"brittany-01312": {
"flake": false,
"locked": {
"narHash": "sha256-4rDE2bu4C8cv1D6lkTtLxMwLRyDfIK70BnptSrygK60=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/brittany-0.13.1.2/brittany-0.13.1.2.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/brittany-0.13.1.2/brittany-0.13.1.2.tar.gz"
}
},
"constraints-extras": {
"flake": false,
"locked": {
"narHash": "sha256-WGDSpT37RrHwpQtExGkL5eEmBk/s9b0rxtT9DYqSGg4=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/constraints-extras-0.3.2.1/constraints-extras-0.3.2.1.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/constraints-extras-0.3.2.1/constraints-extras-0.3.2.1.tar.gz"
}
},
"flake-compat": {
"flake": false,
"locked": {
@ -51,13 +111,25 @@
"fourmolu": {
"flake": false,
"locked": {
"narHash": "sha256-vbqgYaAd/JUPFGv6O2+OosBXFceKah9OYrjTuEkEZ3E=",
"narHash": "sha256-nmMz6kgI9cRljNSH9lbuozKJ7nd5pM4EKfUs0+x5N4U=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/fourmolu-0.9.0.0/fourmolu-0.9.0.0.tar.gz"
"url": "https://hackage.haskell.org/package/fourmolu-0.10.1.0/fourmolu-0.10.1.0.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/fourmolu-0.9.0.0/fourmolu-0.9.0.0.tar.gz"
"url": "https://hackage.haskell.org/package/fourmolu-0.10.1.0/fourmolu-0.10.1.0.tar.gz"
}
},
"ghc-check": {
"flake": false,
"locked": {
"narHash": "sha256-pmmQMrk6X00+zbsstV49w/Es9+V9gssrXzJoub2ReEs=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/ghc-check-0.5.0.8/ghc-check-0.5.0.8.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/ghc-check-0.5.0.8/ghc-check-0.5.0.8.tar.gz"
}
},
"ghc-exactprint": {
@ -124,28 +196,40 @@
"url": "https://hackage.haskell.org/package/hiedb-0.4.2.0/hiedb-0.4.2.0.tar.gz"
}
},
"hlint": {
"hlint-341": {
"flake": false,
"locked": {
"narHash": "sha256-Kz6adx97kY7ojoDlw3y0R6LQ0h/EtXGR5+N07/b6uGk=",
"narHash": "sha256-qJF5mDe4N5MG7C1x62Aumo2b49tIUvQE3wQe8nBUx4U=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/hlint-3.3.6/hlint-3.3.6.tar.gz"
"url": "https://hackage.haskell.org/package/hlint-3.4.1/hlint-3.4.1.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/hlint-3.3.6/hlint-3.3.6.tar.gz"
"url": "https://hackage.haskell.org/package/hlint-3.4.1/hlint-3.4.1.tar.gz"
}
},
"hlint-34": {
"hlint-35": {
"flake": false,
"locked": {
"narHash": "sha256-mDncRtVkjWnUbZc1fgDMGcGjy8CFNxUF8z2HGuuN7GU=",
"narHash": "sha256-qQNUlQQnahUGEO92Lm0RwjTGBGr2Yaw0KRuFRMoc5No=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/hlint-3.4/hlint-3.4.tar.gz"
"url": "https://hackage.haskell.org/package/hlint-3.5/hlint-3.5.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/hlint-3.4/hlint-3.4.tar.gz"
"url": "https://hackage.haskell.org/package/hlint-3.5/hlint-3.5.tar.gz"
}
},
"hw-prim": {
"flake": false,
"locked": {
"narHash": "sha256-++rg/bx4TjWUDyHSWKm/8ITwQLonPRLXHPLlnhJy8ik=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/hw-prim-0.6.3.2/hw-prim-0.6.3.2.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/hw-prim-0.6.3.2/hw-prim-0.6.3.2.tar.gz"
}
},
"implicit-hie": {
@ -162,11 +246,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1668650906,
"narHash": "sha256-JuiYfDO23O8oxUUOmhQflmOoJovyC5G4RjcYQMQjrRE=",
"lastModified": 1670827406,
"narHash": "sha256-nLNk7uiLbhbvb4TVz67XK7+Ezr1zcWYDWmNrWGmEUqA=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "3a86856a13c88c8c64ea32082a851fefc79aa700",
"rev": "ffca9ffaaafb38c8979068cee98b2644bd3f14cb",
"type": "github"
},
"original": {
@ -188,22 +272,55 @@
"url": "https://hackage.haskell.org/package/ptr-poker-0.1.2.8/ptr-poker-0.1.2.8.tar.gz"
}
},
"retrie": {
"flake": false,
"locked": {
"narHash": "sha256-yokMPa3T7gO3YGwaE0CwCO+vG4IVvObSo+q8fzGbAvc=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/retrie-1.2.1/retrie-1.2.1.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/retrie-1.2.1/retrie-1.2.1.tar.gz"
}
},
"retrie-1100": {
"flake": false,
"locked": {
"narHash": "sha256-yn8gguMdBtrB3fCa+4Rq6GHtPSyxYlriENPTgOvjeHE=",
"type": "tarball",
"url": "https://hackage.haskell.org/package/retrie-1.1.0.0/retrie-1.1.0.0.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://hackage.haskell.org/package/retrie-1.1.0.0/retrie-1.1.0.0.tar.gz"
}
},
"root": {
"inputs": {
"aeson-1520": "aeson-1520",
"all-cabal-hashes-unpacked": "all-cabal-hashes-unpacked",
"apply-refact": "apply-refact",
"apply-refact-0930": "apply-refact-0930",
"brittany-01312": "brittany-01312",
"constraints-extras": "constraints-extras",
"flake-compat": "flake-compat",
"flake-utils": "flake-utils",
"fourmolu": "fourmolu",
"ghc-check": "ghc-check",
"ghc-exactprint": "ghc-exactprint",
"ghc-exactprint-150": "ghc-exactprint-150",
"ghc-exactprint-160": "ghc-exactprint-160",
"gitignore": "gitignore",
"hiedb": "hiedb",
"hlint": "hlint",
"hlint-34": "hlint-34",
"hlint-341": "hlint-341",
"hlint-35": "hlint-35",
"hw-prim": "hw-prim",
"implicit-hie": "implicit-hie",
"nixpkgs": "nixpkgs",
"ptr-poker": "ptr-poker"
"ptr-poker": "ptr-poker",
"retrie": "retrie",
"retrie-1100": "retrie-1100"
}
}
},

59
flake.nix
View File

@ -39,16 +39,40 @@
url = "https://hackage.haskell.org/package/ghc-exactprint-1.4.1/ghc-exactprint-1.4.1.tar.gz";
flake = false;
};
ghc-check = {
url = "https://hackage.haskell.org/package/ghc-check-0.5.0.8/ghc-check-0.5.0.8.tar.gz";
flake = false;
};
constraints-extras = {
url = "https://hackage.haskell.org/package/constraints-extras-0.3.2.1/constraints-extras-0.3.2.1.tar.gz";
flake = false;
};
retrie-1100 = {
url = "https://hackage.haskell.org/package/retrie-1.1.0.0/retrie-1.1.0.0.tar.gz";
flake = false;
};
retrie = {
url = "https://hackage.haskell.org/package/retrie-1.2.1/retrie-1.2.1.tar.gz";
flake = false;
};
aeson-1520= {
url = "https://hackage.haskell.org/package/aeson-1.5.2.0/aeson-1.5.2.0.tar.gz";
flake = false;
};
brittany-01312 = {
url = "https://hackage.haskell.org/package/brittany-0.13.1.2/brittany-0.13.1.2.tar.gz";
flake = false;
};
fourmolu = {
url = "https://hackage.haskell.org/package/fourmolu-0.9.0.0/fourmolu-0.9.0.0.tar.gz";
url = "https://hackage.haskell.org/package/fourmolu-0.10.1.0/fourmolu-0.10.1.0.tar.gz";
flake = false;
};
hlint = {
url = "https://hackage.haskell.org/package/hlint-3.3.6/hlint-3.3.6.tar.gz";
hlint-341 = {
url = "https://hackage.haskell.org/package/hlint-3.4.1/hlint-3.4.1.tar.gz";
flake = false;
};
hlint-34 = {
url = "https://hackage.haskell.org/package/hlint-3.4/hlint-3.4.tar.gz";
hlint-35 = {
url = "https://hackage.haskell.org/package/hlint-3.5/hlint-3.5.tar.gz";
flake = false;
};
ptr-poker = {
@ -59,6 +83,18 @@
url = "https://hackage.haskell.org/package/hiedb-0.4.2.0/hiedb-0.4.2.0.tar.gz";
flake = false;
};
hw-prim = {
url = "https://hackage.haskell.org/package/hw-prim-0.6.3.2/hw-prim-0.6.3.2.tar.gz";
flake = false;
};
apply-refact = {
url = "https://hackage.haskell.org/package/apply-refact-0.11.0.0/apply-refact-0.11.0.0.tar.gz";
flake = false;
};
apply-refact-0930 = {
url = "https://hackage.haskell.org/package/apply-refact-0.9.3.0/apply-refact-0.9.3.0.tar.gz";
flake = false;
};
implicit-hie = {
url = "https://hackage.haskell.org/package/implicit-hie-0.1.2.7/implicit-hie-0.1.2.7.tar.gz";
flake = false;
@ -126,6 +162,11 @@
# Patches don't apply
github = overrideCabal hsuper.github (drv: { patches = []; });
hiedb = hsuper.callCabal2nix "hiedb" inputs.hiedb {};
hw-prim = hsuper.callCabal2nix "hw-prim" inputs.hw-prim {};
retrie = hsuper.callCabal2nix "retrie" inputs.retrie {};
retrie_1_1_0_0 = hsuper.callCabal2nix "retrie" inputs.retrie-1100 {};
apply-refact = hsuper.callCabal2nix "apply-refact" inputs.apply-refact {};
apply-refact_0_9_3_0 = hsuper.callCabal2nix "apply-refact" inputs.apply-refact-0930 {};
implicit-hie = hsuper.callCabal2nix "implicit-hie" inputs.implicit-hie {};
# https://github.com/NixOS/nixpkgs/issues/140774
@ -260,11 +301,15 @@
# @guibou: I'm not sure this is needed.
hlint
pkgs.haskellPackages.opentelemetry-extra
capstone tracy
capstone
# ormolu
# stylish-haskell
pre-commit
] ++ lib.optionals stdenv.isDarwin
] ++ lib.optionals (!stdenv.isDarwin)
[ # tracy has a build problem on macos.
tracy
]
++ lib.optionals stdenv.isDarwin
(with darwin.apple_sdk.frameworks; [
Cocoa
CoreServices

12
haskell-language-server.cabal
View File

@ -262,7 +262,7 @@ common rename
cpp-options: -Dhls_rename
common retrie
if flag(retrie) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(retrie)
build-depends: hls-retrie-plugin ^>= 1.0
cpp-options: -Dhls_retrie
@ -272,7 +272,7 @@ common tactic
cpp-options: -Dhls_tactic
common hlint
if flag(hlint) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(hlint)
build-depends: hls-hlint-plugin ^>= 1.1
cpp-options: -Dhls_hlint
@ -292,7 +292,7 @@ common pragmas
cpp-options: -Dhls_pragmas
common splice
if flag(splice) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(splice)
build-depends: hls-splice-plugin ^>=1.0.0.1
cpp-options: -Dhls_splice
@ -317,7 +317,7 @@ common changeTypeSignature
cpp-options: -Dhls_changeTypeSignature
common gadt
if flag(gadt) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(gadt)
build-depends: hls-gadt-plugin ^>= 1.0
cpp-options: -Dhls_gadt
@ -339,7 +339,7 @@ common floskell
cpp-options: -Dhls_floskell
common fourmolu
if flag(fourmolu) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(fourmolu)
build-depends: hls-fourmolu-plugin ^>= 1.1
cpp-options: -Dhls_fourmolu
@ -359,7 +359,7 @@ common brittany
cpp-options: -Dhls_brittany
common refactor
if flag(refactor) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))
if flag(refactor)
build-depends: hls-refactor-plugin ^>= 1.0
cpp-options: -Dhls_refactor

8
plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal
View File

@ -23,10 +23,6 @@ source-repository head
location: git://github.com/haskell/haskell-language-server.git
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules:
Ide.Plugin.Fourmolu
, Ide.Plugin.Fourmolu.Shim
@ -51,10 +47,6 @@ library
default-language: Haskell2010
test-suite tests
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test

8
plugins/hls-gadt-plugin/hls-gadt-plugin.cabal
View File

@ -20,10 +20,6 @@ source-repository head
location: https://github.com/haskell/haskell-language-server.git
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules: Ide.Plugin.GADT
other-modules: Ide.Plugin.GHC
@ -54,10 +50,6 @@ library
default-extensions: DataKinds
test-suite tests
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test

9
plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs
View File

@ -111,7 +111,12 @@ h98ToGADTConDecl dataName tyVars ctxt = \case
renderDetails :: HsConDeclH98Details GP -> HsConDeclGADTDetails GP
renderDetails (PrefixCon _ args) = PrefixConGADT args
renderDetails (InfixCon arg1 arg2) = PrefixConGADT [arg1, arg2]
#if MIN_VERSION_ghc(9,3,0)
renderDetails (RecCon recs) = RecConGADT recs noHsUniTok
#else
renderDetails (RecCon recs) = RecConGADT recs
#endif
#else
renderDetails (PrefixCon args) = PrefixCon args
renderDetails (InfixCon arg1 arg2) = PrefixCon [arg1, arg2]
@ -185,7 +190,11 @@ prettyGADTDecl df decl =
adjustTyClD = \case
Right (L _ (TyClD _ tycld)) -> Right $ adjustDataDecl tycld
Right x -> Left $ "Expect TyClD but got " <> showAst x
#if MIN_VERSION_ghc(9,3,0)
Left err -> Left $ printWithoutUniques err
#else
Left err -> Left $ show err
#endif
adjustDataDecl DataDecl{..} = DataDecl
{ tcdDExt = adjustWhere tcdDExt

8
plugins/hls-gadt-plugin/test/Main.hs
View File

@ -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 (==GHC92) "Single deriving has different output on ghc9.2" $
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "Single deriving has different output on ghc9.2+" $
runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14
, knownBrokenForGhcVersions [GHC92] "Single deriving has different output on ghc9.2" $
, knownBrokenForGhcVersions [GHC92,GHC94] "Single deriving has different output on ghc9.2+" $
runTest "SingleDeriving" "SingleDeriving" 2 0 3 14
, onlyWorkForGhcVersions (==GHC92) "only ghc-9.2 enabled GADTs pragma implicitly" $
, onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "only ghc-9.2+ enabled GADTs pragma implicitly" $
gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False
, knownBrokenForGhcVersions [GHC92] "ghc-9.2 has enabled GADTs pragma implicitly" $
, knownBrokenForGhcVersions [GHC92,GHC94] "ghc-9.2 has enabled GADTs pragma implicitly" $
gadtPragmaTest "insert pragma" True
]

15
plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
View File

@ -30,10 +30,6 @@ flag pedantic
manual: True
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules: Ide.Plugin.Hlint
hs-source-dirs: src
build-depends:
@ -51,7 +47,7 @@ library
, ghc-exactprint >=0.6.3.4
, ghcide ^>=1.8
, hashable
, hlint < 3.5
, hlint < 3.6
, hls-plugin-api ^>=1.5
, hslogger
, lens
@ -63,9 +59,12 @@ library
, text
, transformers
, unordered-containers
, apply-refact >=0.9.0.0
, ghc-lib-parser
, ghc-lib-parser-ex
if impl(ghc >= 9.2)
build-depends: apply-refact ^>= 0.11.0.0
else
build-depends: apply-refact ^>= 0.9.0.0
cpp-options: -DHLINT_ON_GHC_LIB
ghc-options:
@ -81,10 +80,6 @@ library
TypeOperators
test-suite tests
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test

13
plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
View File

@ -67,6 +67,9 @@ import Development.IDE.GHC.Compat (DynFlags,
wopt)
import qualified Development.IDE.GHC.Compat.Util as EnumSet
#if MIN_GHC_API_VERSION(9,4,0)
import qualified "ghc-lib-parser" GHC.Data.Strict as Strict
#endif
#if MIN_GHC_API_VERSION(9,0,0)
import "ghc-lib-parser" GHC.Types.SrcLoc hiding
(RealSrcSpan)
@ -158,7 +161,9 @@ instance Pretty Log where
type BufSpan = ()
#endif
pattern RealSrcSpan :: GHC.RealSrcSpan -> Maybe BufSpan -> GHC.SrcSpan
#if MIN_GHC_API_VERSION(9,0,0)
#if MIN_GHC_API_VERSION(9,4,0)
pattern RealSrcSpan x y <- GHC.RealSrcSpan x (fromStrictMaybe -> y)
#elif MIN_GHC_API_VERSION(9,0,0)
pattern RealSrcSpan x y = GHC.RealSrcSpan x y
#else
pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y))
@ -166,6 +171,12 @@ pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y))
{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
#endif
#if MIN_GHC_API_VERSION(9,4,0)
fromStrictMaybe :: Strict.Maybe a -> Maybe a
fromStrictMaybe (Strict.Just a ) = Just a
fromStrictMaybe Strict.Nothing = Nothing
#endif
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId = (defaultPluginDescriptor plId)
{ pluginRules = rules recorder plId

8
plugins/hls-refactor-plugin/hls-refactor-plugin.cabal
View File

@ -22,10 +22,6 @@ source-repository head
location: https://github.com/haskell/haskell-language-server.git
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules: Development.IDE.GHC.ExactPrint
Development.IDE.GHC.Compat.ExactPrint
Development.IDE.Plugin.CodeAction
@ -94,10 +90,6 @@ library
default-language: Haskell2010
test-suite tests
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test

5
plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs
View File

@ -2,9 +2,6 @@
-- multiple ghc-exactprint versions, accepting that anything more ambitious is
-- pretty much impossible with the GHC 9.2 redesign of ghc-exactprint
module Development.IDE.GHC.Compat.ExactPrint
#if MIN_VERSION_ghc(9,3,0)
( ) where
#else
( ExactPrint
, exactPrint
, makeDeltaAst
@ -34,5 +31,3 @@ pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA
pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast
pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA))
#endif
#endif

9
plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs
View File

@ -9,10 +9,10 @@ import GHC.Hs.Dump
import qualified Data.ByteString as B
import Development.IDE.GHC.Compat.Util
import Generics.SYB (ext1Q, ext2Q, extQ)
import GHC.Hs
import GHC.Hs hiding (AnnLet)
#endif
#if MIN_VERSION_ghc(9,0,1)
import GHC.Plugins
import GHC.Plugins hiding (AnnLet)
#else
import GhcPlugins
#endif
@ -232,8 +232,13 @@ showAstDataHtml a0 = html $
annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")
#if MIN_VERSION_ghc(9,4,0)
annotationEpAnnHsLet :: EpAnn NoEpAnns -> SDoc
annotationEpAnnHsLet = annotation' (text "EpAnn NoEpAnns")
#else
annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc
annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet")
#endif
annotationAnnList :: EpAnn AnnList -> SDoc
annotationAnnList = annotation' (text "EpAnn AnnList")

24
plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs
View File

@ -3,9 +3,6 @@
-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.
module Development.IDE.GHC.ExactPrint
#if MIN_VERSION_ghc(9,3,0)
( ) where
#else
( Graft(..),
graftDecls,
graftDeclsWithM,
@ -95,11 +92,14 @@ import Ide.PluginUtils
import Language.Haskell.GHC.ExactPrint.Parsers
import Language.LSP.Types
import Language.LSP.Types.Capabilities (ClientCapabilities)
import Retrie.ExactPrint hiding (Annotated (..),
parseDecl, parseExpr,
import Retrie.ExactPrint hiding (parseDecl,
parseExpr,
parsePattern,
parseType)
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,9,0)
import GHC.Plugins (showSDoc)
import GHC.Utils.Outputable (Outputable (ppr))
#elif MIN_VERSION_ghc(9,2,0)
import GHC (EpAnn (..),
NameAdornment (NameParens),
NameAnn (..),
@ -696,7 +696,10 @@ annotate :: (ASTElement l ast, Outputable l)
annotate dflags needs_space ast = do
uniq <- show <$> uniqueSrcSpanT
let rendered = render dflags ast
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
expr' <- lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
pure expr'
#elif MIN_VERSION_ghc(9,2,0)
expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered
pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
#else
@ -734,7 +737,10 @@ annotateDecl dflags
annotateDecl dflags ast = do
uniq <- show <$> uniqueSrcSpanT
let rendered = render dflags ast
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
expr' <- 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
pure $ setPrecedingLines expr' 1 0
#else
@ -819,5 +825,3 @@ isCommaAnn :: TrailingAnn -> Bool
isCommaAnn AddCommaAnn{} = True
isCommaAnn _ = False
#endif
#endif

44
plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs
View File

@ -70,6 +70,9 @@ import Development.IDE.Types.Logger hiding
import Development.IDE.Types.Options
import GHC.Exts (fromList)
import qualified GHC.LanguageExtensions as Lang
#if MIN_VERSION_ghc(9,4,0)
import GHC.Parser.Annotation (TokenLocation (..))
#endif
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Language.LSP.Server as LSP
@ -141,12 +144,10 @@ iePluginDescriptor recorder plId =
wrap suggestExportUnusedTopBinding
, wrap suggestModuleTypo
, wrap suggestFixConstructorImport
#if !MIN_VERSION_ghc(9,3,0)
, wrap suggestExtendImport
, wrap suggestImportDisambiguation
, wrap suggestNewOrExtendImportForClassMethod
, wrap suggestHideShadow
#endif
, wrap suggestNewImport
]
plId
@ -158,10 +159,8 @@ typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
wrap $ suggestSignature True
, wrap suggestFillTypeWildcard
, wrap suggestAddTypeAnnotationToSatisfyConstraints
#if !MIN_VERSION_ghc(9,3,0)
, wrap removeRedundantConstraints
, wrap suggestConstraint
#endif
]
plId
@ -169,9 +168,7 @@ bindingsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> Plugin
bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
mkGhcideCAsPlugin [
wrap suggestReplaceIdentifier
#if !MIN_VERSION_ghc(9,3,0)
, wrap suggestImplicitParameter
#endif
, wrap suggestNewDefinition
, wrap Development.IDE.Plugin.Plugins.AddArgument.plugin
, wrap suggestDeleteUnusedBinding
@ -376,7 +373,6 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l)
-- imported from ‘Data.ByteString’ at B.hs:6:1-22
-- imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
-- imported from ‘Data.Text’ at B.hs:7:1-16
#if !MIN_VERSION_ghc(9,3,0)
suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range}
| Just [identifier, modName, s] <-
@ -408,7 +404,6 @@ suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range}
then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps fileContents
else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl
| otherwise = []
#endif
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
findImportDeclByModuleName decls modName = flip find decls $ \case
@ -829,6 +824,18 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range,
| otherwise = []
where
makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")"
#if MIN_VERSION_ghc(9,4,0)
pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable "
, ".*to type ‘([^ ]+)’ "
, "in the following constraint"
, if multiple then "s" else ""
, ".*arising from the literal ‘(.+)’"
, if inArg then ".+In the.+argument" else ""
, if at then ".+at" else ""
, if inExpr then ".+In the expression" else ""
, ".+In the expression"
]
#else
pat multiple at inArg inExpr = T.concat [ ".*Defaulting the following constraint"
, if multiple then "s" else ""
, " to type ‘([^ ]+)’ "
@ -838,12 +845,12 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range,
, if inExpr then ".+In the expression" else ""
, ".+In the expression"
]
#endif
codeEdit ty lit replacement =
let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’"
edits = [TextEdit _range replacement]
in [( title, edits )]
-- | GHC strips out backticks in case of infix functions as well as single quote
-- in case of quoted name when using TemplateHaskellQuotes. Which is not desired.
--
@ -916,7 +923,6 @@ newDefinitionAction IdeOptions {..} parsedModule Range {_start} name typ
sig = name <> colon <> T.dropWhileEnd isSpace (fromMaybe "_" typ)
ParsedModule {pm_parsed_source = L _ HsModule {hsmodDecls}} = parsedModule
{- Handles two variants with different formatting
1. Could not find module ‘Data.Cha’
@ -943,8 +949,6 @@ suggestModuleTypo Diagnostic{_range=_range,..}
[modul, "(from", _] -> Just modul
_ -> Nothing
#if !MIN_VERSION_ghc(9,3,0)
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]
suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}
| Just [binding, mod, srcspan] <-
@ -992,7 +996,6 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
{ name = mkVarOrDataOcc binding
, parent = Nothing
, identModuleName = mkModuleNameFS $ mkFastStringByteString $ T.encodeUtf8 mod}
#endif
data HidingMode
= HideOthers [ModuleTarget]
@ -1018,7 +1021,6 @@ oneAndOthers = go
isPreludeImplicit :: DynFlags -> Bool
isPreludeImplicit = xopt Lang.ImplicitPrelude
#if !MIN_VERSION_ghc(9,3,0)
-- | Suggests disambiguation for ambiguous symbols.
suggestImportDisambiguation ::
DynFlags ->
@ -1110,7 +1112,6 @@ suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..}
<> "."
<> symbol
suggestImportDisambiguation _ _ _ _ _ = []
#endif
occursUnqualified :: T.Text -> ImportDecl GhcPs -> Bool
occursUnqualified symbol ImportDecl{..}
@ -1133,7 +1134,6 @@ targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) =
targetModuleName (ExistingImp _) =
error "Cannot happen!"
#if !MIN_VERSION_ghc(9,3,0)
disambiguateSymbol ::
Annotated ParsedSource ->
T.Text ->
@ -1166,7 +1166,6 @@ disambiguateSymbol ps fileContents Diagnostic {..} (T.unpack -> symbol) = \case
liftParseAST @RdrName df $
T.unpack $ printOutputable $ L (mkGeneralSrcSpan "") rdr
]
#endif
findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
findImportDeclByRange xs range = find (\(L (locA -> l) _)-> srcSpanToRange l == Just range) xs
@ -1185,7 +1184,6 @@ suggestFixConstructorImport Diagnostic{_range=_range,..}
in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)]
| otherwise = []
#if !MIN_VERSION_ghc(9,3,0)
-- | Suggests a constraint for a declaration for which a constraint is missing.
suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..}
@ -1267,12 +1265,10 @@ suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _rang
[( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId)
, appendConstraint (T.unpack implicitT) hsib_body)]
| otherwise = []
#endif
findTypeSignatureName :: T.Text -> Maybe T.Text
findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " <&> head
#if !MIN_VERSION_ghc(9,3,0)
-- | Suggests a constraint for a type signature with any number of existing constraints.
suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]
@ -1316,7 +1312,7 @@ suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing
-- | Suggests the removal of a redundant constraint for a type signature.
removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..}
removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagnostic{..}
-- • Redundant constraint: Eq a
-- • In the type signature for:
-- foo :: forall a. Eq a => a -> a
@ -1420,7 +1416,6 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos
<> [(quickFixImportKind "new.all", newImportAll moduleText)]
| otherwise -> []
where moduleText = moduleNameText identInfo
#endif
suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]
suggestNewImport packageExportsMap ps fileContents Diagnostic{_message}
@ -1730,8 +1725,13 @@ extractQualifiedModuleName x
extractDoesNotExportModuleName :: T.Text -> Maybe T.Text
extractDoesNotExportModuleName x
| Just [m] <-
#if MIN_VERSION_ghc(9,4,0)
matchRegexUnifySpaces x "the module ‘([^’]*)’ does not export"
<|> matchRegexUnifySpaces x "nor ‘([^’]*)’ export"
#else
matchRegexUnifySpaces x "Module ‘([^’]*)’ does not export"
<|> matchRegexUnifySpaces x "nor ‘([^’]*)’ exports"
#endif
= Just m
| otherwise
= Nothing

22
plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs
View File

@ -13,6 +13,8 @@ module Development.IDE.Plugin.CodeAction.Args
where
import Control.Concurrent.STM.Stats (readTVarIO)
import Control.Monad.Except (ExceptT (..),
runExceptT)
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.Either (fromRight,
@ -27,12 +29,8 @@ import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Compat.ExactPrint
import Development.IDE.GHC.ExactPrint
#if !MIN_VERSION_ghc(9,3,0)
import Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite,
rewriteToEdit)
#endif
import Control.Monad.Except (ExceptT (..),
runExceptT)
import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),
GlobalBindingTypeSigsResult)
import Development.IDE.Spans.LocalBindings (Bindings)
@ -75,9 +73,7 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra
Just (_, txt) -> pure txt
_ -> pure Nothing
caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule
#if !MIN_VERSION_ghc(9,3,0)
caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource
#endif
caaTmr <- onceIO $ runRule TypeCheck
caaHar <- onceIO $ runRule GetHieAst
caaBindings <- onceIO $ runRule GetBindings
@ -122,7 +118,6 @@ class ToTextEdit a where
instance ToTextEdit TextEdit where
toTextEdit _ = pure . pure
#if !MIN_VERSION_ghc(9,3,0)
instance ToTextEdit Rewrite where
toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $
runMaybeT $ do
@ -134,7 +129,6 @@ instance ToTextEdit Rewrite where
let r = rewriteToEdit df rw
#endif
pure $ fromRight [] r
#endif
instance ToTextEdit a => ToTextEdit [a] where
toTextEdit caa = foldMap (toTextEdit caa)
@ -154,11 +148,7 @@ data CodeActionArgs = CodeActionArgs
caaParsedModule :: IO (Maybe ParsedModule),
caaContents :: IO (Maybe T.Text),
caaDf :: IO (Maybe DynFlags),
#if MIN_VERSION_ghc(9,3,0)
caaAnnSource :: IO (Maybe ParsedSource),
#else
caaAnnSource :: IO (Maybe (Annotated ParsedSource)),
#endif
caaTmr :: IO (Maybe TcModuleResult),
caaHar :: IO (Maybe HieAstResult),
caaBindings :: IO (Maybe Bindings),
@ -238,10 +228,10 @@ instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where
Just s -> flip runReaderT caa . runExceptT . toCodeAction . f . astA $ s
_ -> pure $ Right []
#else
toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} ->
toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} ->
x >>= \case
Just s -> flip runReaderT caa . toCodeAction . f . pm_parsed_source $ s
_ -> pure []
Just s -> flip runReaderT caa . runExceptT . toCodeAction . f . pm_parsed_source $ s
_ -> pure $ Right []
#endif
instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where
@ -271,13 +261,11 @@ instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
toCodeAction = toCodeAction2 caaDf
#if !MIN_VERSION_ghc(9,3,0)
instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where
toCodeAction = toCodeAction1 caaAnnSource
instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where
toCodeAction = toCodeAction2 caaAnnSource
#endif
instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where
toCodeAction = toCodeAction1 caaTmr

60
plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
View File

@ -48,7 +48,8 @@ import GHC (AddEpAnn (..), AnnContext (..), AnnList (..),
IsUnicodeSyntax (NormalSyntax),
NameAdornment (NameParens),
TrailingAnn (AddCommaAnn), addAnns, ann,
emptyComments, reAnnL)
emptyComments, noSrcSpanA, reAnnL)
import Language.Haskell.GHC.ExactPrint.ExactPrint (makeDeltaAst, showAst)
#else
import Control.Applicative (Alternative ((<|>)))
import Control.Monad.Extra (whenJust)
@ -62,6 +63,7 @@ import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
KeywordId (G), mkAnnKey)
#endif
------------------------------------------------------------------------------
-- | Construct a 'Rewrite', replacing the node at the given 'SrcSpan' with the
@ -196,26 +198,30 @@ removeConstraint ::
removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input"
where
go :: LHsType GhcPs -> Rewrite
#if !MIN_VERSION_ghc(9,2,0)
go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do
#else
#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,4,0)
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do
#else
go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do
#endif
let ctxt' = filter (not . toRemove) ctxt
removeStuff = (toRemove <$> headMaybe ctxt) == Just True
#if !MIN_VERSION_ghc(9,2,0)
when removeStuff $
setEntryDPT hst_body (DP (0, 0))
return $ L l $ it{hst_ctxt = L l' ctxt'}
#else
#if MIN_VERSION_ghc(9,2,0)
let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body
return $ case ctxt' of
[] -> hst_body'
_ -> do
let ctxt'' = over _last (first removeComma) ctxt'
#if MIN_VERSION_ghc(9,4,0)
L l $ it{ hst_ctxt = L l' ctxt''
#else
L l $ it{ hst_ctxt = Just $ L l' ctxt''
#endif
, hst_body = hst_body'
}
#else
when removeStuff $
setEntryDPT hst_body (DP (0, 0))
return $ L l $ it{hst_ctxt = L l' ctxt'}
#endif
go (L _ (HsParTy _ ty)) = go ty
go (L _ HsForAllTy{hst_body}) = go hst_body
@ -231,10 +237,12 @@ appendConstraint ::
Rewrite
appendConstraint constraintT = go . traceAst "appendConstraint"
where
#if !MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do
#else
#elif MIN_VERSION_ghc(9,2,0)
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do
#else
go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do
#endif
constraint <- liftParseAST df constraintT
#if !MIN_VERSION_ghc(9,2,0)
@ -258,7 +266,11 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
[L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close
_ -> Nothing
ctxt' = over _last (first addComma) $ map dropHsParTy ctxt
#if MIN_VERSION_ghc(9,4,0)
return $ L l $ it{hst_ctxt = L l'' $ ctxt' ++ [constraint]}
#else
return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]}
#endif
#endif
go (L _ HsForAllTy{hst_body}) = go hst_body
go (L _ (HsParTy _ ty)) = go ty
@ -267,7 +279,16 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
constraint <- liftParseAST df constraintT
lContext <- uniqueSrcSpanT
lTop <- uniqueSrcSpanT
#if !MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
let context = reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
#else
let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
#endif
annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]
needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint
ast <- pure $ setEntryDP ast (SameLine 1)
#else
let context = L lContext [constraint]
addSimpleAnnT context dp00 $
(G AnnDarrow, DP (0, 1)) :
@ -277,11 +298,6 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
]
| hsTypeNeedsParens sigPrec $ unLoc constraint
]
#else
let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]
needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint
ast <- pure $ setEntryDP ast (SameLine 1)
#endif
return $ reLocA $ L lTop $ HsQualTy noExtField context ast
@ -336,8 +352,16 @@ extendImport mparent identifier lDecl@(L l _) =
Rewrite (locA l) $ \df -> do
case mparent of
-- This will also work for `ImportAllConstructors`
#if !MIN_VERSION_ghc(9,2,0)
Just parent -> extendImportViaParent df parent identifier lDecl
_ -> extendImportTopLevel identifier lDecl
#else
-- Parsed source in GHC 9.4 uses absolute position annotation (RealSrcSpan),
-- while rewriting relies on relative positions. ghc-exactprint has the utility
-- makeDeltaAst for relativization.
Just parent -> extendImportViaParent df parent identifier (makeDeltaAst lDecl)
_ -> extendImportTopLevel identifier (makeDeltaAst lDecl)
#endif
-- | Add an identifier or a data type to import list. Expects a Delta AST
--
@ -506,7 +530,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
#else
let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr')
parentRdr' = modifyAnns parentRdr $ \case
it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1}
it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1, nann_close = epl 0}
other -> other
childLIE = reLocA $ L srcChild $ IEName childRdr
#endif

10
plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs
View File

@ -1,6 +1,10 @@
{-# LANGUAGE CPP #-}
module Development.IDE.Plugin.Plugins.AddArgument (plugin) where
#if MIN_VERSION_ghc(9,4,0)
import Development.IDE.GHC.ExactPrint (epl)
import GHC.Parser.Annotation (TokenLocation (..))
#endif
#if !MIN_VERSION_ghc(9,2,1)
import qualified Data.Text as T
import Language.LSP.Types
@ -140,8 +144,14 @@ hsTypeFromFunTypeAsList (args, res) =
addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> (LHsSigType GhcPs)
addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) =
let (args, res) = hsTypeToFunTypeAsList lsigTy
#if MIN_VERSION_ghc(9,4,0)
wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem []) emptyComments) generatedSrcSpan
arrowAnn = TokenLoc (epl 1)
newArg = (SrcSpanAnn mempty generatedSrcSpan, noAnn, HsUnrestrictedArrow (L arrowAnn HsNormalTok), L wildCardAnn $ HsWildCardTy noExtField)
#else
wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem [AddRarrowAnn d1]) emptyComments) generatedSrcSpan
newArg = (SrcSpanAnn mempty generatedSrcSpan, noAnn, HsUnrestrictedArrow NormalSyntax, L wildCardAnn $ HsWildCardTy noExtField)
#endif
-- NOTE if the location that the argument wants to be placed at is not one more than the number of arguments
-- in the signature, then we return the original type signature.
-- This situation most likely occurs due to a function type synonym in the signature

51
plugins/hls-refactor-plugin/test/Main.hs
View File

@ -103,7 +103,8 @@ initializeTests = withResource acquire release tests
doTest = do
ir <- getInitializeResponse
let Just ExecuteCommandOptions {_commands = List commands} = getActual $ innerCaps ir
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) expected commands
-- Check if expected exists in commands. Note that commands can arrive in different order.
mapM_ (\e -> any (\o -> T.isSuffixOf e o) commands @? show (expected, show commands)) expected
acquire :: IO (ResponseMessage Initialize)
acquire = run initializeResponse
@ -746,6 +747,7 @@ typeWildCardActionTests = testGroup "type wildcard actions"
contentAfterAction <- documentContents doc
liftIO $ expectedContentAfterAction @=? contentAfterAction
{-# HLINT ignore "Use nubOrd" #-}
removeImportTests :: TestTree
removeImportTests = testGroup "remove import actions"
@ -1291,7 +1293,8 @@ extendImportTests = testGroup "extend import actions"
, "b :: A"
, "b = ConstructorFoo"
])
, testSession "extend single line qualified import with value" $ template
, ignoreForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $
testSession "extend single line qualified import with value" $ template
[("ModuleA.hs", T.unlines
[ "module ModuleA where"
, "stuffA :: Double"
@ -1462,7 +1465,7 @@ extendImportTests = testGroup "extend import actions"
, "import A (pattern Some)"
, "k (Some x) = x"
])
, ignoreForGHC92 "Diagnostic message has no suggestions" $
, ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $
testSession "type constructor name same as data constructor name" $ template
[("ModuleA.hs", T.unlines
[ "module ModuleA where"
@ -2324,7 +2327,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f = 1"
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (3, 4), "Defaulting the type variable") ]
#else
[ (DsWarning, (3, 4), "Defaulting the following constraint") ]
#endif
"Add type annotation ‘Integer’ to ‘1’"
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "module A (f) where"
@ -2341,7 +2348,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, " let x = 3"
, " in x"
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (4, 12), "Defaulting the type variable") ]
#else
[ (DsWarning, (4, 12), "Defaulting the following constraint") ]
#endif
"Add type annotation ‘Integer’ to ‘3’"
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "module A where"
@ -2359,7 +2370,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, " let x = let y = 5 in y"
, " in x"
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (4, 20), "Defaulting the type variable") ]
#else
[ (DsWarning, (4, 20), "Defaulting the following constraint") ]
#endif
"Add type annotation ‘Integer’ to ‘5’"
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "module A where"
@ -2378,9 +2393,15 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f = seq \"debug\" traceShow \"debug\""
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (6, 8), "Defaulting the type variable")
, (DsWarning, (6, 16), "Defaulting the type variable")
]
#else
[ (DsWarning, (6, 8), "Defaulting the following constraint")
, (DsWarning, (6, 16), "Defaulting the following constraint")
]
#endif
("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "{-# LANGUAGE OverloadedStrings #-}"
@ -2390,7 +2411,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\""
])
, knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $
, knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $
testSession "add default type to satisfy two constraints" $
testFor
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
@ -2401,7 +2422,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f a = traceShow \"debug\" a"
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (6, 6), "Defaulting the type variable") ]
#else
[ (DsWarning, (6, 6), "Defaulting the following constraint") ]
#endif
("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "{-# LANGUAGE OverloadedStrings #-}"
@ -2411,7 +2436,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a"
])
, knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $
, knownBrokenForGhcVersions [GHC92, GHC94] "GHC 9.2 only has 'traceShow' in error span" $
testSession "add default type to satisfy two constraints with duplicate literals" $
testFor
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
@ -2422,7 +2447,11 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t
, ""
, "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))"
])
#if MIN_VERSION_ghc(9,4,0)
[ (DsWarning, (6, 54), "Defaulting the type variable") ]
#else
[ (DsWarning, (6, 54), "Defaulting the following constraint") ]
#endif
("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")
(T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"
, "{-# LANGUAGE OverloadedStrings #-}"
@ -3039,15 +3068,15 @@ removeRedundantConstraintsTests = let
"Remove redundant constraints `(Monoid a, Show a)` from the context of the type signature for `foo`"
(typeSignatureSpaces $ Just "Monoid a, Show a")
(typeSignatureSpaces Nothing)
, check
, check
"Remove redundant constraint `Eq a` from the context of the type signature for `foo`"
typeSignatureLined1
typeSignatureOneLine
, check
, check
"Remove redundant constraints `(Eq a, Show a)` from the context of the type signature for `foo`"
typeSignatureLined2
typeSignatureOneLine
, check
, check
"Remove redundant constraint `Show a` from the context of the type signature for `foo`"
typeSignatureLined3
typeSignatureLined3'
@ -3117,7 +3146,7 @@ exportUnusedTests = testGroup "export unused actions"
(R 2 0 2 11)
"Export ‘bar’"
Nothing
, ignoreForGHC92 "Diagnostic message has no suggestions" $
, ignoreFor (BrokenForGHC [GHC92, GHC94]) "Diagnostic message has no suggestions" $
testSession "type is exported but not the constructor of same name" $ template
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
@ -3754,6 +3783,9 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
ignoreForGHC92 :: String -> TestTree -> TestTree
ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92])
ignoreForGHC94 :: String -> TestTree -> TestTree
ignoreForGHC94 = ignoreFor (BrokenForGHC [GHC94])
data BrokenTarget =
BrokenSpecific OS [GhcVersion]
-- ^Broken for `BrokenOS` with `GhcVersion`
@ -3799,4 +3831,3 @@ assertJust s = \case
listOfChar :: T.Text
listOfChar | ghcVersion >= GHC90 = "String"
| otherwise = "[Char]"

4
plugins/hls-retrie-plugin/hls-retrie-plugin.cabal
View File

@ -17,10 +17,6 @@ source-repository head
location: https://github.com/haskell/haskell-language-server.git
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules: Ide.Plugin.Retrie
hs-source-dirs: src
build-depends:

9
plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
View File

@ -96,6 +96,11 @@ import Language.LSP.Types as J hiding
import Retrie.CPP (CPP (NoCPP), parseCPP)
import Retrie.ExactPrint (Annotated, fix,
transformA, unsafeMkA)
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.PkgQual
#endif
#if MIN_VERSION_ghc(9,2,0)
import Retrie.ExactPrint (makeDeltaAst)
#else
@ -548,7 +553,11 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..}
ideclSource' = if ideclSource then IsBoot else NotBoot
toMod = noLocA . GHC.mkModuleName
ideclName = toMod ideclNameString
#if MIN_VERSION_ghc(9,3,0)
ideclPkgQual = NoRawPkgQual
#else
ideclPkgQual = Nothing
#endif
ideclSafe = False
ideclImplicit = False
ideclHiding = Nothing

8
plugins/hls-splice-plugin/hls-splice-plugin.cabal
View File

@ -27,10 +27,6 @@ source-repository head
location: https://github.com/haskell/haskell-language-server.git
library
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
exposed-modules:
Ide.Plugin.Splice
Ide.Plugin.Splice.Types
@ -64,10 +60,6 @@ library
TypeOperators
test-suite tests
if impl(ghc >= 9.3)
buildable: False
else
buildable: True
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test

42
plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
View File

@ -51,8 +51,11 @@ 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
#if MIN_VERSION_ghc(9,4,1)
import GHC.Data.Bag (Bag)
#endif
import GHC.Exts
#if __GLASGOW_HASKELL__ >= 902
#if MIN_VERSION_ghc(9,2,0)
import GHC.Parser.Annotation (SrcSpanAnn'(..))
import qualified GHC.Types.Error as Error
#endif
@ -271,7 +274,7 @@ adjustToRange uri ran (WorkspaceEdit mhult mlt x) =
-- `GenLocated`. In GHC >= 9.2 this will be a SrcSpanAnn', with annotations;
-- earlier it will just be a plain `SrcSpan`.
{-# COMPLETE AsSrcSpan #-}
#if __GLASGOW_HASKELL__ >= 902
#if MIN_VERSION_ghc(9,2,0)
pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a
pattern AsSrcSpan locA <- SrcSpanAnn {locA}
#else
@ -369,12 +372,12 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
Right y -> unRenamedE dflags y
_ -> pure Nothing
let (warns, errs) =
#if __GLASGOW_HASKELL__ >= 902
#if MIN_VERSION_ghc(9,2,0)
(Error.getWarningMessages msgs, Error.getErrorMessages msgs)
#else
msgs
#endif
pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl
pure $ (warns,) <$> fromMaybe (Left $ showErrors errs) eresl
unless
(null warns)
@ -382,12 +385,31 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
MtWarning
[ "Warning during expanding: "
, ""
, T.pack (show warns)
, T.pack (showErrors warns)
]
pure resl
where
dflags = hsc_dflags hscEnv
#if MIN_VERSION_ghc(9,4,1)
showErrors = showBag
#else
showErrors = show
#endif
#if MIN_VERSION_ghc(9,4,1)
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
showBag = show . fmap (fmap toDiagnosticMessage)
toDiagnosticMessage :: Error.Diagnostic a => a -> Error.DiagnosticMessage
toDiagnosticMessage message =
Error.DiagnosticMessage
{ diagMessage = Error.diagnosticMessage message
, diagReason = Error.diagnosticReason message
, diagHints = Error.diagnosticHints message
}
#endif
-- | FIXME: Is thereAny "clever" way to do this exploiting TTG?
unRenamedE ::
forall ast m l.
@ -397,15 +419,21 @@ unRenamedE ::
TransformT m (LocatedAn l (ast GhcPs))
unRenamedE dflags expr = do
uniq <- show <$> uniqueSrcSpanT
#if __GLASGOW_HASKELL__ >= 902
#if MIN_VERSION_ghc(9,2,0)
expr' <-
#else
(_anns, expr') <-
#endif
either (fail . show) pure $
either (fail . showErrors) pure $
parseAST @_ @(ast GhcPs) dflags uniq $
showSDoc dflags $ ppr expr
pure expr'
where
#if MIN_VERSION_ghc(9,4,1)
showErrors = showBag . Error.getMessages
#else
showErrors = show
#endif
data SearchResult r =
Continue | Stop | Here r

23
test/functional/FunctionalCodeAction.hs
View File

@ -260,15 +260,15 @@ typedHoleTests = testGroup "typed hole code actions" [
, "foo x = maxBound"
]
, expectFailIfGhc92 "The wingman plugin doesn't yet compile in GHC92" $
testCase "doesn't work when wingman is active" $
runSession hlsCommand fullCaps "test/testdata" $ do
doc <- openDoc "TypedHoles.hs" "haskell"
_ <- waitForDiagnosticsFromSource doc "typecheck"
cas <- getAllCodeActions doc
liftIO $ do
dontExpectCodeAction cas ["replace _ with minBound"]
dontExpectCodeAction cas ["replace _ with foo _"]
, knownBrokenForGhcVersions [GHC92, GHC94] "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"
_ <- waitForDiagnosticsFromSource doc "typecheck"
cas <- getAllCodeActions doc
liftIO $ do
dontExpectCodeAction cas ["replace _ with minBound"]
dontExpectCodeAction cas ["replace _ with foo _"]
, testCase "shows more suggestions" $
runSession hlsCommand fullCaps "test/testdata" $ do
@ -295,7 +295,7 @@ typedHoleTests = testGroup "typed hole code actions" [
, " stuff (A a) = A (a + 1)"
]
, expectFailIfGhc92 "The wingman plugin doesn't yet compile in GHC92" $
, knownBrokenForGhcVersions [GHC92, GHC94] "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"
@ -384,9 +384,6 @@ unusedTermTests = testGroup "unused term code actions" [
$ Just CodeActionQuickFix `notElem` kinds
]
expectFailIfGhc92 :: String -> TestTree -> TestTree
expectFailIfGhc92 = knownBrokenForGhcVersions [GHC92]
disableWingman :: Session ()
disableWingman =
sendConfigurationChanged $ toJSON $ def