diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index c96ae6ee421e22ab842077be272ea7c1f309662a..c2b1d7e87a221b35b8e3a999a2d5f3cdc0e2c46d 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -178,7 +178,7 @@ jobs:
name: Test hls-class-plugin
run: cabal test hls-class-plugin --test-options="-j1 --rerun-update" || cabal test hls-class-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="-j1 --rerun"
- - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc }}
+ - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
name: Test hls-eval-plugin
run: cabal test hls-eval-plugin --test-options="-j1 --rerun-update" || cabal test hls-eval-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="-j1 --rerun"
@@ -186,7 +186,7 @@ jobs:
name: Test hls-haddock-comments-plugin
run: cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun-update" || cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun"
- - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc != '9.0.1' }}
+ - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
name: Test hls-splice-plugin
run: cabal test hls-splice-plugin --test-options="-j1 --rerun-update" || cabal test hls-splice-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="-j1 --rerun"
@@ -206,7 +206,7 @@ jobs:
name: Test hls-tactics-plugin test suite
run: cabal test hls-tactics-plugin --test-options="-j1 --rerun-update" || cabal test hls-tactics-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="-j1 --rerun"
- - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc != '9.0.1' }}
+ - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
name: Test hls-refine-imports-plugin test suite
run: cabal test hls-refine-imports-plugin --test-options="-j1 --rerun-update" || cabal test hls-refine-imports-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="-j1 --rerun"
diff --git a/cabal-ghc901.project b/cabal-ghc901.project
index 4ef97612d0c6581dec9fff401798f32e86e065ea..34331958de366df70528a24ed474fef6cae916d7 100644
--- a/cabal-ghc901.project
+++ b/cabal-ghc901.project
@@ -6,19 +6,19 @@ packages:
./ghcide
./hls-plugin-api
./hls-test-utils
- -- ./plugins/hls-tactics-plugin
- -- ./plugins/hls-brittany-plugin
- -- ./plugins/hls-stylish-haskell-plugin
- -- ./plugins/hls-fourmolu-plugin
+ -- ./plugins/hls-tactics-plugin
+ -- ./plugins/hls-brittany-plugin
+ -- ./plugins/hls-stylish-haskell-plugin
+ -- ./plugins/hls-fourmolu-plugin
-- ./plugins/hls-class-plugin
./plugins/hls-eval-plugin
./plugins/hls-explicit-imports-plugin
- -- ./plugins/hls-refine-imports-plugin
+ ./plugins/hls-refine-imports-plugin
./plugins/hls-hlint-plugin
./plugins/hls-rename-plugin
./plugins/hls-retrie-plugin
./plugins/hls-haddock-comments-plugin
- -- ./plugins/hls-splice-plugin
+ ./plugins/hls-splice-plugin
./plugins/hls-floskell-plugin
./plugins/hls-pragmas-plugin
./plugins/hls-module-name-plugin
@@ -48,10 +48,10 @@ source-repository-package
source-repository-package
type: git
- location: https://github.com/anka-213/dependent-sum
- tag: 8cf4c7fbc3bfa2be475a17bb7c94a1e1e9a830b5
+ location: https://github.com/fendor/dependent-sum
+ tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118
subdir: dependent-sum-template
--- https://github.com/obsidiansystems/dependent-sum/pull/57
+-- https://github.com/obsidiansystems/dependent-sum/pull/59
-- benchmark dependency
source-repository-package
@@ -64,8 +64,8 @@ write-ghc-environment-files: never
index-state: 2021-09-06T12:12:22Z
constraints:
- -- These plugins doesn't work on GHC9 yet
- haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports
+ -- These plugins don't work on GHC9 yet
+ haskell-language-server -brittany -class -fourmolu -stylishhaskell -tactic
allow-newer:
floskell:base,
diff --git a/cabal-ghc921.project b/cabal-ghc921.project
new file mode 100644
index 0000000000000000000000000000000000000000..10f24917de37f7cf5673d8c94c7a2e033d7fb3e4
--- /dev/null
+++ b/cabal-ghc921.project
@@ -0,0 +1,275 @@
+packages:
+ ./
+ ./hie-compat
+ ./shake-bench
+ ./hls-graph
+ ./ghcide
+ ./hls-plugin-api
+ ./hls-test-utils
+ -- ./plugins/hls-tactics-plugin
+ -- ./plugins/hls-brittany-plugin
+ -- ./plugins/hls-stylish-haskell-plugin
+ -- ./plugins/hls-fourmolu-plugin
+ ./plugins/hls-class-plugin
+ ./plugins/hls-eval-plugin
+ ./plugins/hls-explicit-imports-plugin
+ ./plugins/hls-refine-imports-plugin
+ ./plugins/hls-hlint-plugin
+ -- ./plugins/hls-retrie-plugin
+ ./plugins/hls-haddock-comments-plugin
+ -- ./plugins/hls-splice-plugin
+ ./plugins/hls-floskell-plugin
+ ./plugins/hls-pragmas-plugin
+ ./plugins/hls-module-name-plugin
+ ./plugins/hls-ormolu-plugin
+ ./plugins/hls-call-hierarchy-plugin
+
+tests: true
+
+package *
+ ghc-options: -haddock
+ test-show-details: direct
+
+source-repository-package
+ type: git
+ location: https://github.com/mithrandi/czipwith.git
+ tag: b6245884ae83e00dd2b5261762549b37390179f8
+ -- https://github.com/lspitzner/czipwith/pull/2
+
+-- benchmark dependency
+source-repository-package
+ type: git
+ location: https://github.com/HeinrichApfelmus/operational
+ tag: 16e19aaf34e286f3d27b3988c61040823ec66537
+
+-- Head of hiedb
+source-repository-package
+ type: git
+ location: https://github.com/wz1000/HieDb
+ tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8
+
+-- GHC 9.2 for ghc-check
+source-repository-package
+ type: git
+ location: https://github.com/fendor/ghc-check
+ tag: 224f3901eaa1b32a27e097968afd4a3894efa77e
+ -- https://github.com/pepeiborra/ghc-check/pull/14/files
+
+write-ghc-environment-files: never
+
+index-state: 2021-08-31T02:21:16Z
+
+constraints:
+ -- These plugins doesn't work on GHC9 yet
+ haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy -retrie
+
+
+allow-newer:
+ Cabal,
+ base,
+ binary,
+ bytestring,
+ ghc,
+ ghc-bignum,
+ ghc-prim,
+ integer-gmp,
+ template-haskell,
+ text,
+ time,
+
+ diagrams-postscript:lens,
+ diagrams-postscript:diagrams-core,
+ diagrams-postscript:monoid-extras,
+ dependent-sum:some,
+ dependent-sum:constraints,
+ diagrams:diagrams-core,
+ Chart-diagrams:diagrams-core,
+ SVGFonts:diagrams-core
+
+constraints:
+ Agda ==2.6.1.3,
+ Diff ==0.4.0,
+ EdisonAPI ==1.3.1,
+ EdisonCore ==1.3.2.1,
+ FPretty ==1.1,
+ HTTP ==4000.3.16,
+ HUnit ==1.6.2.0,
+ QuickCheck ==2.14.2,
+ Spock-core ==0.14.0.0,
+ aeson ==1.5.6.0,
+ aivika ==5.9.1,
+ aivika-transformers ==5.9.1,
+ alex ==3.2.6,
+ ansi-pretty ==0.1.2.2,
+ arith-encode ==1.0.2,
+ async ==2.2.3,
+ async-pool ==0.9.1,
+ attoparsec ==0.13.2.5 || ==0.14.1,
+ barbies-th ==0.1.8,
+ base-compat ==0.11.2,
+ base-compat-batteries ==0.11.2,
+ base16-bytestring ==1.0.1.0,
+ basement ==0.0.12,
+ bits ==0.5.3,
+ blaze-builder ==0.4.2.1,
+ blaze-textual ==0.2.1.0,
+ boomerang ==1.4.7,
+ bound ==2.0.3,
+ box-tuples ==0.2.0.4,
+ byteslice ==0.2.5.2,
+ bytesmith ==0.3.7.0,
+ bytestring-strict-builder ==0.4.5.4,
+ cabal-doctest ==1.0.8,
+ cantor-pairing ==0.2.0.1,
+ cassava ==0.5.2.0,
+ cborg ==0.2.5.0,
+ cereal ==0.5.8.1,
+ charset ==0.3.8,
+ chaselev-deque ==0.5.0.5,
+ classy-prelude ==1.5.0,
+ combinat ==0.2.10.0,
+ commonmark-extensions ==0.2.1.2,
+ conduit ==1.3.4.1,
+ constraints ==0.13,
+ constraints-extras ==0.3.1.0,
+ cql ==4.0.3,
+ critbit ==0.2.0.0,
+ cryptonite ==0.29,
+ data-default-instances-new-base ==0.0.2,
+ data-dword ==0.3.2,
+ data-r-tree ==0.6.0,
+ datetime ==0.3.1,
+ deferred-folds ==0.9.17,
+ dependent-sum-template ==0.1.0.3,
+ deriving-compat ==0.5.10,
+ diagrams-lib ==1.4.4,
+ doctest ==0.18.1,
+ dom-lt ==0.2.2.1,
+ drinkery ==0.4,
+ edit-distance ==0.2.2.1,
+ emacs-module ==0.1.1,
+ endo ==0.3.0.1,
+ entropy ==0.4.1.6,
+ enumeration ==0.2.0,
+ extra ==1.7.9,
+ fgl ==5.7.0.3,
+ filepattern ==0.1.2,
+ focus ==1.0.2,
+ free-algebras ==0.1.0.1,
+ free-functors ==1.2.1,
+ generic-data ==0.9.2.0,
+ generic-deriving ==1.14,
+ generic-lens ==2.2.0.0,
+ generic-lens-core ==2.2.0.0,
+ generic-optics ==2.2.0.0,
+ generics-sop ==0.5.1.1,
+ geniplate-mirror ==0.7.8,
+ ghc-events ==0.17.0,
+ happy ==1.20.0,
+ hashtables ==1.2.4.1,
+ haskeline ==0.7.5.0,
+ haskell-src-exts ==1.23.1,
+ haskell-src-meta ==0.8.7,
+ haxl ==2.3.0.0,
+ heterocephalus ==1.0.5.4,
+ hgeometry ==0.12.0.4,
+ hgeometry-ipe ==0.12.0.0,
+ hscolour ==1.24.4,
+ hslogger ==1.3.1.0,
+ hspec-core ==2.8.3,
+ hspec-discover ==2.8.3,
+ hspec-expectations ==0.8.2,
+ hspec-meta ==2.7.8,
+ hspec-wai ==0.11.1,
+ http-types ==0.12.3,
+ http2 ==3.0.2,
+ hvect ==0.4.0.0,
+ hxt ==9.3.1.22,
+ inj-base ==0.2.0.0,
+ inspection-testing ==0.4.6.0,
+ invariant ==0.5.4,
+ io-choice ==0.0.7,
+ iproute ==1.7.11,
+ language-c ==0.9.0.1,
+ language-haskell-extract ==0.2.4,
+ language-javascript ==0.7.1.0,
+ lens ==5.0.1,
+ lens-family-th ==0.5.2.0,
+ list-t ==1.0.4,
+ lockfree-queue ==0.2.3.1,
+ memory ==0.16.0,
+ microlens-ghc ==0.4.13,
+ monad-validate ==1.2.0.0,
+ monadplus ==1.4.2,
+ mono-traversable ==1.0.15.1,
+ mono-traversable-keys ==0.1.0,
+ mustache ==2.3.1,
+ network ==3.1.2.2,
+ newtype-generics ==0.6,
+ obdd ==0.8.2,
+ optics-th ==0.4,
+ packman ==0.5.0,
+ pandoc ==2.14.2,
+ parameterized-utils ==2.1.3.0,
+ partial-isomorphisms ==0.2.2.1,
+ pem ==0.2.4,
+ persistent ==2.13.0.3 || ==2.13.1.1,
+ plots ==0.1.1.2,
+ pointed ==5.0.2,
+ posix-api ==0.3.5.0,
+ primitive-extras ==0.10.1.1,
+ primitive-sort ==0.1.0.0,
+ primitive-unlifted ==0.1.3.0,
+ proto3-wire ==1.2.2,
+ quickcheck-instances ==0.3.25.2,
+ random ==1.2.0,
+ relude ==1.0.0.1,
+ row-types ==1.0.1.0,
+ safe ==0.3.19,
+ safecopy ==0.10.4.2,
+ salak ==0.3.6,
+ securemem ==0.1.10,
+ semialign ==1.2,
+ semigroupoids ==5.3.5,
+ serialise ==0.2.3.0,
+ servant ==0.18.3,
+ shake ==0.19.5,
+ shakespeare ==2.0.25,
+ singletons ==3.0,
+ singletons-base ==3.0,
+ siphash ==1.0.3,
+ snap-core ==1.0.4.2,
+ streaming-commons ==0.2.2.1,
+ streamly ==0.8.0,
+ subcategories ==0.1.1.0,
+ test-framework ==0.8.2.0,
+ text-format ==0.3.2,
+ text-short ==0.1.3,
+ text-show ==3.9,
+ th-desugar ==1.12,
+ th-extras ==0.0.0.4,
+ threads ==0.5.1.6,
+ tls ==1.5.5,
+ tpdb ==2.2.0,
+ tree-diff ==0.2,
+ true-name ==0.1.0.3,
+ uniplate ==1.6.13,
+ unordered-containers ==0.2.14.0,
+ validity ==0.11.0.1,
+ vector-builder ==0.3.8.2,
+ vector-circular ==0.1.3,
+ vector-th-unbox ==0.2.1.9,
+ vinyl ==0.13.3,
+ vty ==5.33,
+ wai-app-static ==3.1.7.2,
+ wai-extra ==3.1.6,
+ wai-middleware-static ==0.9.0,
+ warp ==3.3.17,
+ winery ==1.3.2,
+ witherable ==0.4.1,
+ x509 ==1.7.5,
+ x509-validation ==1.6.11,
+ xlsx ==0.8.4,
+ xml-hamlet ==0.5.0.1,
+ yaml ==0.11.5.0,
+ yesod-core ==1.6.21.0
diff --git a/configuration-ghc-901.nix b/configuration-ghc-901.nix
index 79a04cf0acf80283ce3a3cd975461c5a322d362c..f10724f125072b12ced499e30faca4274e1a9b4e 100644
--- a/configuration-ghc-901.nix
+++ b/configuration-ghc-901.nix
@@ -7,9 +7,7 @@ let
"hls-brittany-plugin"
"hls-stylish-haskell-plugin"
"hls-fourmolu-plugin"
- "hls-splice-plugin"
"hls-class-plugin"
- "hls-refine-imports-plugin"
];
hpkgsOverride = hself: hsuper:
@@ -23,23 +21,10 @@ let
};
in {
- # we need add ghc-api-compat to build depends,
- # since its condition tree is not evaluated under ghc 9
-
- ghc-api-compat = hself.callHackageDirect {
- pkg = "ghc-api-compat";
- ver = "9.0.1";
- sha256 = "WCK1gu6iiCAc2s2rFEqn2CkvHkITPrmDjuiGsWOWerM=";
- } {};
-
- hiedb = addBuildDepend hsuper.hiedb hself.ghc-api-compat;
-
blaze-textual = hself.callCabal2nix "blaze-textual"
- (pkgs.fetchFromGitHub {
- owner = "jwaldmann";
- repo = "blaze-textual";
- rev = "d8ee6cf80e27f9619d621c936bb4bda4b99a183f";
- sha256 = "C0dIzf64fBaY8mlhMm1kCQC5Jc1wKBtNO2Y24k7YPUw=";
+ (builtins.fetchTarball {
+ url = "https://hackage.haskell.org/package/blaze-textual-0.2.2.1/blaze-textual-0.2.2.1.tar.gz";
+ sha256 = "1nyhc9mrnxsl21ksnpp0ryki4wgk49r581yy504g2gjq6x3bkb59";
}) { };
czipwith = hself.callCabal2nix "czipwith" (pkgs.fetchFromGitHub {
@@ -49,12 +34,11 @@ let
sha256 = "2uSoGyrxT/OstRcpx55kwP4JwjPbWLxD72LajeyQV0E=";
}) { };
- hie-bios = hself.callCabal2nix "hie-bios" (pkgs.fetchFromGitHub {
- owner = "jneira";
- repo = "hie-bios";
- rev = "9b1445ab5efcabfad54043fc9b8e50e9d8c5bbf3";
- sha256 = "8ct7t3xIxIAoC+f8VO5e5+QKrd5L5Zu1eButSaE+1Uk=";
- }) { };
+ hie-bios = hself.callCabal2nix "hie-bios"
+ (builtins.fetchTarball {
+ url = "https://hackage.haskell.org/package/hie-bios-0.7.6/hie-bios-0.7.6.tar.gz";
+ sha256 = "0w4rhy4b3jnci9m27l79c8n28wl56x49bmhdn7pvf88mx9srjcvq";
+ }) { };
th-extras = hself.callCabal2nix "th-extras" (pkgs.fetchFromGitHub {
owner = "anka-213";
@@ -100,10 +84,8 @@ let
"-f-brittany"
"-f-class"
"-f-fourmolu"
- "-f-splice"
"-f-stylishhaskell"
"-f-tactic"
- "-f-refineImports"
]) { };
# YOLO
diff --git a/flake.nix b/flake.nix
index d5dc999ed1024cc0d58507e64682ecbf8a1217bc..5104b4ae339b03835af651179319a32632493c73 100644
--- a/flake.nix
+++ b/flake.nix
@@ -70,12 +70,11 @@
# Don't use `callHackage`, it requires us to override `all-cabal-hashes`
tweaks = hself: hsuper:
with haskell.lib; {
-
- ghc-api-compat = hself.callHackageDirect {
- pkg = "ghc-api-compat";
- ver = "8.10.7";
- sha256 = "g9/InDeQfiXCB9SK8mpl/8B5QEEobj9uqo4xe//telw=";
- } {};
+ hiedb = hself.callCabal2nix "hiedb"
+ (builtins.fetchTarball {
+ url = "https://hackage.haskell.org/package/hiedb-0.4.1.0/hiedb-0.4.1.0.tar.gz";
+ sha256 = "11s7lfkd6fc3zf3kgyp3jhicbhxpn6jp0yjahl8d28hicwr2qdpi";
+ }) { };
lsp = hself.lsp_1_2_0_1;
diff --git a/ghcide/.ghci b/ghcide/.ghci
deleted file mode 100644
index 8eb094939ee1a1a646906f580175be881c372536..0000000000000000000000000000000000000000
--- a/ghcide/.ghci
+++ /dev/null
@@ -1,29 +0,0 @@
-:set -Wunused-binds -Wunused-imports -Worphans -Wunused-matches -Wincomplete-patterns
-
-:set -XBangPatterns
-:set -XDeriveFunctor
-:set -XDeriveGeneric
-:set -XGeneralizedNewtypeDeriving
-:set -XLambdaCase
-:set -XNamedFieldPuns
-:set -XOverloadedStrings
-:set -XRecordWildCards
-:set -XScopedTypeVariables
-:set -XStandaloneDeriving
-:set -XTupleSections
-:set -XTypeApplications
-:set -XViewPatterns
-
-:set -package=ghc
-:set -ignore-package=ghc-lib-parser
-:set -DGHC_STABLE
-:set -Iinclude
-:set -idist/build/autogen
-:set -isrc
-:set -isession-loader
-:set -iexe
-
-:set -isrc-ghc88
-:set -idist-newstyle/build/x86_64-osx/ghc-8.8.3/ghcide-0.2.0/build/autogen
-
-:load Main
diff --git a/ghcide/.gitignore b/ghcide/.gitignore
index e6abe0e03ca9044c5b58f4411862061b9c8cfcf7..3544e898b056af8569df2001839e755b36abbdb1 100644
--- a/ghcide/.gitignore
+++ b/ghcide/.gitignore
@@ -7,7 +7,9 @@ cabal.project.local
/.tasty-rerun-log
.vscode
/.hlint-*
-bench/example/
+bench/example/*
+# don't ignore the example file, we need it!
+!bench/example/HLS
bench-results/
bench-temp/
.shake/
diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml
index 2bb82f5a5a44a584fbb0ff009dd6c63979fd1c75..725604f7df41f2603d1e60681649f4293f02fc9e 100644
--- a/ghcide/.hlint.yaml
+++ b/ghcide/.hlint.yaml
@@ -94,6 +94,16 @@
- Development.IDE.Core.Rules
- Development.IDE.Core.Tracing
- Development.IDE.GHC.Compat
+ - Development.IDE.GHC.Compat.Core
+ - Development.IDE.GHC.Compat.Env
+ - Development.IDE.GHC.Compat.Iface
+ - Development.IDE.GHC.Compat.Logger
+ - Development.IDE.GHC.Compat.Outputable
+ - Development.IDE.GHC.Compat.Parser
+ - Development.IDE.GHC.Compat.Plugins
+ - Development.IDE.GHC.Compat.Units
+ - Development.IDE.GHC.Compat.Util
+ - Development.IDE.GHC.CPP
- Development.IDE.GHC.ExactPrint
- Development.IDE.GHC.Orphans
- Development.IDE.GHC.Util
@@ -112,7 +122,8 @@
- flags:
- default: false
- {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]}
- - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.Benchmark.Rules]}
+ - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.IDE.GHC.Compat.Core, Development.Benchmark.Rules]}
+ - {name: [-Wno-unused-imports], within: [Development.IDE.GHC.Compat.Core]}
- {name: [-Wno-deprecations, -Wno-unticked-promoted-constructors], within: [Main, Experiments]}
# - modules:
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS
deleted file mode 120000
index a8a4f8c2127bf74725cf14800dde7ea8aeec5c5c..0000000000000000000000000000000000000000
--- a/ghcide/bench/example/HLS
+++ /dev/null
@@ -1 +0,0 @@
-../../..
\ No newline at end of file
diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS
new file mode 100644
index 0000000000000000000000000000000000000000..f95f775b78b6d1fcd2c52833a391d5a249d709dd
--- /dev/null
+++ b/ghcide/bench/example/HLS
@@ -0,0 +1 @@
+../../..
diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index 5a1dca79ef6a1489fc12bce7b10d7a26e2936290..66cc4166abec4db7aa2444ea0ae067f7b4dca7ca 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -61,7 +61,7 @@ library
hie-compat ^>= 0.2.0.0,
hls-plugin-api ^>= 1.2.0.0,
lens,
- hiedb == 0.4.0.*,
+ hiedb == 0.4.1.*,
lsp-types >= 1.3.0.1 && < 1.4,
lsp == 1.2.*,
mtl,
@@ -110,22 +110,6 @@ library
build-depends:
unix
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
default-extensions:
ApplicativeDo
BangPatterns
@@ -171,6 +155,15 @@ library
Development.IDE.Core.Tracing
Development.IDE.Core.UseStale
Development.IDE.GHC.Compat
+ Development.IDE.GHC.Compat.Core
+ Development.IDE.GHC.Compat.Env
+ Development.IDE.GHC.Compat.Iface
+ Development.IDE.GHC.Compat.Logger
+ Development.IDE.GHC.Compat.Outputable
+ Development.IDE.GHC.Compat.Parser
+ Development.IDE.GHC.Compat.Plugins
+ Development.IDE.GHC.Compat.Units
+ Development.IDE.GHC.Compat.Util
Development.IDE.Core.Compile
Development.IDE.GHC.Error
Development.IDE.GHC.ExactPrint
@@ -220,6 +213,10 @@ library
if flag(ghc-patched-unboxed-bytecode)
cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE
+ if impl(ghc < 8.10)
+ exposed-modules:
+ Development.IDE.GHC.Compat.CPP
+
executable ghcide-test-preprocessor
default-language: Haskell2010
hs-source-dirs: test/preprocessor
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
index b769ed916a3bb527d88219ff1c459eb4d3ffdd89..edc31ed5fe1f1da4abca7349ab7ecabc1d2d6973 100644
--- a/ghcide/session-loader/Development/IDE/Session.hs
+++ b/ghcide/session-loader/Development/IDE/Session.hs
@@ -19,7 +19,7 @@ module Development.IDE.Session
import Control.Concurrent.Async
import Control.Concurrent.Strict
-import Control.Exception.Safe
+import Control.Exception.Safe as Safe
import Control.Monad
import Control.Monad.Extra
import Control.Monad.IO.Class
@@ -42,9 +42,13 @@ import Data.Time.Clock
import Data.Version
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
-import Development.IDE.GHC.Compat hiding (Target,
- TargetFile, TargetModule)
-import qualified Development.IDE.GHC.Compat as GHC
+import qualified Development.IDE.GHC.Compat as Compat
+import Development.IDE.GHC.Compat.Core hiding (Target,
+ TargetFile, TargetModule,
+ Var)
+import qualified Development.IDE.GHC.Compat.Core as GHC
+import Development.IDE.GHC.Compat.Env hiding (Logger)
+import Development.IDE.GHC.Compat.Units (UnitId)
import Development.IDE.GHC.Util
import Development.IDE.Graph (Action)
import Development.IDE.Session.VersionCheck
@@ -71,12 +75,6 @@ import System.Info
import Control.Applicative (Alternative ((<|>)))
import Control.Exception (evaluate)
import Data.Void
-import GHCi
-import HscTypes (hsc_IC, hsc_NC,
- hsc_dflags, ic_dflags)
-import Linker
-import Module
-import NameCache
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue
@@ -105,7 +103,7 @@ data SessionLoadingOptions = SessionLoadingOptions
, getCacheDirs :: String -> [String] -> IO CacheDirs
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
, getInitialGhcLibDir :: FilePath -> IO (Maybe LibDir)
- , fakeUid :: GHC.InstalledUnitId
+ , fakeUid :: UnitId
-- ^ unit id used to tag the internal component built by ghcide
-- To reuse external interface files the unit ids must match,
-- thus make sure to build them with `--this-unit-id` set to the
@@ -118,7 +116,7 @@ instance Default SessionLoadingOptions where
,loadCradle = loadWithImplicitCradle
,getCacheDirs = getCacheDirsDefault
,getInitialGhcLibDir = getInitialGhcLibDirDefault
- ,fakeUid = GHC.toInstalledUnitId (GHC.stringToUnit "main")
+ ,fakeUid = Compat.toUnitId (Compat.stringToUnit "main")
}
-- | Find the cradle for a given 'hie.yaml' configuration.
@@ -173,7 +171,7 @@ runWithDb :: FilePath -> (HieDb -> IndexQueue -> IO ()) -> IO ()
runWithDb fp k = do
-- Delete the database if it has an incompatible schema version
withHieDb fp (const $ pure ())
- `catch` \IncompatibleSchemaVersion{} -> removeFile fp
+ `Safe.catch` \IncompatibleSchemaVersion{} -> removeFile fp
withHieDb fp $ \writedb -> do
initConn writedb
chan <- newTQueueIO
@@ -187,15 +185,15 @@ runWithDb fp k = do
forever $ do
k <- atomically $ readTQueue chan
k db
- `catch` \e@SQLError{} -> do
+ `Safe.catch` \e@SQLError{} -> do
hPutStrLn stderr $ "SQLite error in worker, ignoring: " ++ show e
- `catchAny` \e -> do
+ `Safe.catchAny` \e -> do
hPutStrLn stderr $ "Uncaught error in database worker, ignoring: " ++ show e
getHieDbLoc :: FilePath -> IO FilePath
getHieDbLoc dir = do
- let db = intercalate "-" [dirHash, takeBaseName dir, ghcVersionStr, hiedbDataVersion] <.> "hiedb"
+ let db = intercalate "-" [dirHash, takeBaseName dir, Compat.ghcVersionStr, hiedbDataVersion] <.> "hiedb"
dirHash = B.unpack $ B16.encode $ H.hash $ B.pack dir
cDir <- IO.getXdgDirectory IO.XdgCache cacheDir
createDirectoryIfMissing True cDir
@@ -297,7 +295,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
-- We will modify the unitId and DynFlags used for
-- compilation but these are the true source of
-- information.
- new_deps = RawComponentInfo (thisInstalledUnitId df) df targets cfp opts dep_info
+ new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info
: maybe [] snd oldDeps
-- Get all the unit-ids for things in this component
inplace = map rawComponentUnitId new_deps
@@ -482,7 +480,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
ncfp <- toNormalizedFilePath' <$> canonicalizePath file
cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap
hieYaml <- cradleLoc file
- sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `catch` \e ->
+ sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e ->
return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml)
returnWithVersion $ \file -> do
@@ -522,11 +520,11 @@ cradleToOptsAndLibDir cradle file = do
emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
emptyHscEnv nc libDir = do
env <- runGhc (Just libDir) getSession
- when (ghcVersion < GHC90) $
+ when (Compat.ghcVersion < Compat.GHC90) $
-- This causes ghc9 to crash with the error:
-- Couldn't find a target code interpreter. Try with -fexternal-interpreter
initDynLinker env
- pure $ setNameCache nc env{ hsc_dflags = (hsc_dflags env){useUnicode = True } }
+ pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
data TargetDetails = TargetDetails
{
@@ -571,13 +569,13 @@ newComponentCache
-> Maybe FilePath -- Path to cradle
-> NormalizedFilePath -- Path to file that caused the creation of this component
-> HscEnv
- -> [(InstalledUnitId, DynFlags)]
+ -> [(UnitId, DynFlags)]
-> ComponentInfo
-> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo))
newComponentCache logger exts cradlePath cfp hsc_env uids ci = do
let df = componentDynFlags ci
- let hscEnv' = hsc_env { hsc_dflags = df
- , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
+ let hscEnv' = hscSetFlags df hsc_env
+ { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
henv <- newFunc hscEnv' uids
@@ -676,7 +674,7 @@ type FilesMap = HM.HashMap NormalizedFilePath (Maybe FilePath)
-- This is pristine information about a component
data RawComponentInfo = RawComponentInfo
- { rawComponentUnitId :: InstalledUnitId
+ { rawComponentUnitId :: UnitId
-- | Unprocessed DynFlags. Contains inplace packages such as libraries.
-- We do not want to use them unprocessed.
, rawComponentDynFlags :: DynFlags
@@ -693,14 +691,14 @@ data RawComponentInfo = RawComponentInfo
-- This is processed information about the component, in particular the dynflags will be modified.
data ComponentInfo = ComponentInfo
- { componentUnitId :: InstalledUnitId
+ { componentUnitId :: UnitId
-- | Processed DynFlags. Does not contain inplace packages such as local
-- libraries. Can be used to actually load this Component.
, componentDynFlags :: DynFlags
-- | Internal units, such as local libraries, that this component
-- is loaded with. These have been extracted from the original
-- ComponentOptions.
- , _componentInternalUnits :: [InstalledUnitId]
+ , _componentInternalUnits :: [UnitId]
-- | All targets of this components.
, componentTargets :: [GHC.Target]
-- | Filepath which caused the creation of this component
@@ -733,7 +731,7 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs
where
tryIO :: IO a -> IO (Either IOException a)
- tryIO = try
+ tryIO = Safe.try
do_one :: FilePath -> IO (FilePath, Maybe UTCTime)
do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp)
@@ -747,18 +745,14 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs
-- tcRnImports) which assume that all modules in the HPT have the same unit
-- ID. Therefore we create a fake one and give them all the same unit id.
removeInplacePackages
- :: InstalledUnitId -- ^ fake uid to use for our internal component
- -> [InstalledUnitId]
+ :: UnitId -- ^ fake uid to use for our internal component
+ -> [UnitId]
-> DynFlags
- -> (DynFlags, [InstalledUnitId])
-removeInplacePackages fake_uid us df = (setThisInstalledUnitId fake_uid $
+ -> (DynFlags, [UnitId])
+removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $
df { packageFlags = ps }, uids)
where
- (uids, ps) = partitionEithers (map go (packageFlags df))
- go p@(ExposePackage _ (UnitIdArg u) _) = if GHC.toInstalledUnitId u `elem` us
- then Left (GHC.toInstalledUnitId u)
- else Right p
- go p = Right p
+ (uids, ps) = Compat.filterInplaceUnits us (packageFlags df)
-- | Memoize an IO function, with the characteristics:
--
@@ -790,25 +784,16 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
-- also, it can confuse the interface stale check
dontWriteHieFiles $
setIgnoreInterfacePragmas $
- setLinkerOptions $
+ setBytecodeLinkerOptions $
disableOptimisation $
- setUpTypedHoles $
+ Compat.setUpTypedHoles $
makeDynFlagsAbsolute compRoot dflags'
-- initPackages parses the -package flags and
-- sets up the visibility for each component.
-- Throws if a -package flag cannot be satisfied.
- final_df <- liftIO $ wrapPackageSetupException $ initUnits dflags''
- return (final_df, targets)
-
--- we don't want to generate object code so we compile to bytecode
--- (HscInterpreted) which implies LinkInMemory
--- HscInterpreted
-setLinkerOptions :: DynFlags -> DynFlags
-setLinkerOptions df = df {
- ghcLink = LinkInMemory
- , hscTarget = HscNothing
- , ghcMode = CompManager
- }
+ env <- hscSetFlags dflags'' <$> getSession
+ final_env' <- liftIO $ wrapPackageSetupException $ Compat.initUnits env
+ return (hsc_dflags final_env', targets)
setIgnoreInterfacePragmas :: DynFlags -> DynFlags
setIgnoreInterfacePragmas df =
diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs
index c776ff79088555a1b3362de9559b2d2099b14002..5d27facf546af071602e17299e6fe4bc48dcde9a 100644
--- a/ghcide/src/Development/IDE/Core/Actions.hs
+++ b/ghcide/src/Development/IDE/Core/Actions.hs
@@ -23,17 +23,12 @@ import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
-import Development.IDE.GHC.Compat hiding (TargetFile,
- TargetModule,
- parseModule,
- typecheckModule,
- writeHieFile)
+import Development.IDE.GHC.Compat hiding (writeHieFile)
import Development.IDE.Graph
import qualified Development.IDE.Spans.AtPoint as AtPoint
import Development.IDE.Types.HscEnvEq (hscEnv)
import Development.IDE.Types.Location
import qualified HieDb
-import HscTypes (hsc_dflags)
import Language.LSP.Types (DocumentHighlight (..),
SymbolInformation (..))
@@ -44,7 +39,7 @@ lookupMod
:: HieDbWriter -- ^ access the database
-> FilePath -- ^ The `.hie` file we got from the database
-> ModuleName
- -> UnitId
+ -> Unit
-> Bool -- ^ Is this file a boot file?
-> MaybeT IdeAction Uri
lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing
@@ -64,11 +59,11 @@ getAtPoint file pos = runMaybeT $ do
opts <- liftIO $ getIdeOptionsIO ide
(hf, mapping) <- useE GetHieAst file
- df <- hsc_dflags . hscEnv . fst <$> useE GhcSession file
+ env <- hscEnv . fst <$> useE GhcSession file
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useE GetDocMap file)
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
- MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap df pos'
+ MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap env pos'
toCurrentLocations :: PositionMapping -> [Location] -> [Location]
toCurrentLocations mapping = mapMaybe go
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index 340b7bebd01ff0ef400e5fb523077c81eafeb22a..ce889fb7ba71e9b2670405bb5e561478c386f2fc 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -43,19 +43,18 @@ import Development.IDE.Spans.Common
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Types.Options
-import Outputable hiding ((<>))
+
+import Development.IDE.GHC.Compat hiding (loadInterface,
+ parseHeader, parseModule,
+ tcRnModule, writeHieFile)
+import qualified Development.IDE.GHC.Compat as Compat
+import qualified Development.IDE.GHC.Compat as GHC
+import qualified Development.IDE.GHC.Compat.Util as Util
import HieDb
import Language.LSP.Types (DiagnosticTag (..))
-import DriverPhases
-import DriverPipeline hiding (unP)
-import HscTypes
-import LoadIface (loadModuleInterface)
-
-import Lexer
-import qualified Parser
#if MIN_VERSION_ghc(8,10,0)
import Control.DeepSeq (force, rnf)
#else
@@ -63,35 +62,13 @@ import Control.DeepSeq (rnf)
import ErrUtils
#endif
-import Development.IDE.GHC.Compat hiding (parseModule,
- typecheckModule,
- writeHieFile)
-import qualified Development.IDE.GHC.Compat as Compat
-import qualified Development.IDE.GHC.Compat as GHC
-import Finder
-import GhcMonad
-import GhcPlugins as GHC hiding (fst3, (<>))
-import Hooks
-import HscMain (hscDesugar, hscGenHardCode,
- hscInteractive, hscSimplify,
- hscTypecheckRename,
- makeSimpleDetails)
-import MkIface
-import StringBuffer as SB
-import TcIface (typecheckIface)
-import TcRnMonad hiding (newUnique)
+
#if MIN_VERSION_ghc(9,0,1)
-import GHC.Builtin.Names
-import GHC.Iface.Recomp
import GHC.Tc.Gen.Splice
-import GHC.Tc.Types.Evidence (EvBind)
#else
-import PrelNames
import TcSplice
#endif
-import TidyPgm
-import Bag
import Control.Exception (evaluate)
import Control.Exception.Safe
import Control.Lens hiding (List)
@@ -108,13 +85,13 @@ import Data.Maybe
import qualified Data.Text as T
import Data.Time (UTCTime, getCurrentTime)
import qualified GHC.LanguageExtensions as LangExt
-import HeaderInfo
-import Linker (unload)
-import Maybes (orElse)
import System.Directory
import System.FilePath
import System.IO.Extra (fixIO, newTempFileWithin)
-import TcEnv (tcLookup)
+
+-- GHC API imports
+import GHC (GetDocsFailure (..),
+ parsedSource)
import Control.Concurrent.Extra
import Control.Concurrent.STM hiding (orElse)
@@ -124,8 +101,7 @@ import Data.Coerce
import Data.Functor
import qualified Data.HashMap.Strict as HashMap
import Data.Tuple.Extra (dupe)
-import Data.Unique
-import GHC.Fingerprint
+import Data.Unique as Unique
import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Types as LSP
@@ -146,11 +122,10 @@ parseModule IdeOptions{..} env filename ms =
-- | Given a package identifier, what packages does it depend on
computePackageDeps
:: HscEnv
- -> InstalledUnitId
- -> IO (Either [FileDiagnostic] [InstalledUnitId])
+ -> Unit
+ -> IO (Either [FileDiagnostic] [UnitId])
computePackageDeps env pkg = do
- let dflags = hsc_dflags env
- case oldLookupInstalledPackage dflags pkg of
+ case lookupUnit env pkg of
Nothing -> return $ Left [ideErrorText (toNormalizedFilePath' noFilePath) $
T.pack $ "unknown package: " ++ show pkg]
Just pkgInfo -> return $ Right $ unitDepends pkgInfo
@@ -169,7 +144,12 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do
modSummary' <- initPlugins hsc modSummary
(warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
- tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
+ let
+ session = tweak (hscSetFlags dflags hsc)
+ -- TODO: maybe settings ms_hspp_opts is unnecessary?
+ mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session}
+ in
+ tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''}
let errorPipeline = unDefer . hideDiag dflags . tagDiag
diags = map errorPipeline warnings
deferedError = any fst diags
@@ -180,10 +160,10 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do
-- | Add a Hook to the DynFlags which captures and returns the
-- typechecked splices before they are run. This information
-- is used for hover.
-captureSplices :: DynFlags -> (DynFlags -> IO a) -> IO (a, Splices)
-captureSplices dflags k = do
+captureSplices :: HscEnv -> (HscEnv -> IO a) -> IO (a, Splices)
+captureSplices env k = do
splice_ref <- newIORef mempty
- res <- k (dflags { hooks = addSpliceHook splice_ref (hooks dflags)})
+ res <- k (hscSetHooks (addSpliceHook splice_ref (hsc_hooks env)) env)
splices <- readIORef splice_ref
return (res, splices)
where
@@ -217,14 +197,13 @@ captureSplices dflags k = do
tcRnModule :: HscEnv -> [Linkable] -> ParsedModule -> IO TcModuleResult
tcRnModule hsc_env keep_lbls pmod = do
let ms = pm_mod_summary pmod
- hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
+ hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) hsc_env
unload hsc_env_tmp keep_lbls
((tc_gbl_env, mrn_info), splices)
- <- liftIO $ captureSplices (ms_hspp_opts ms) $ \dflags ->
- do let hsc_env_tmp = hsc_env { hsc_dflags = dflags }
- hscTypecheckRename hsc_env_tmp ms $
+ <- liftIO $ captureSplices (hscSetFlags (ms_hspp_opts ms) hsc_env) $ \hsc_env_tmp ->
+ do hscTypecheckRename hsc_env_tmp ms $
HsParsedModule { hpm_module = parsedSource pmod,
hpm_src_files = pm_extra_src_files pmod,
hpm_annotations = pm_annotations pmod }
@@ -235,7 +214,7 @@ tcRnModule hsc_env keep_lbls pmod = do
mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult
mkHiFileResultNoCompile session tcm = do
- let hsc_env_tmp = session { hsc_dflags = ms_hspp_opts ms }
+ let hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) session
ms = pm_mod_summary $ tmrParsed tcm
tcGblEnv = tmrTypechecked tcm
details <- makeSimpleDetails hsc_env_tmp tcGblEnv
@@ -255,7 +234,7 @@ mkHiFileResultCompile
-> LinkableType -- ^ use object code or byte code?
-> IO (IdeResult HiFileResult)
mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
- let session = session' { hsc_dflags = ms_hspp_opts ms }
+ let session = hscSetFlags (ms_hspp_opts ms) session'
ms = pm_mod_summary $ tmrParsed tcm
tcGblEnv = tmrTypechecked tcm
@@ -297,8 +276,8 @@ mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
initPlugins :: HscEnv -> ModSummary -> IO ModSummary
initPlugins session modSummary = do
- dflags <- liftIO $ initializePlugins session $ ms_hspp_opts modSummary
- return modSummary{ms_hspp_opts = dflags}
+ session1 <- liftIO $ initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session)
+ return modSummary{ms_hspp_opts = hsc_dflags session1}
-- | Whether we should run the -O0 simplifier when generating core.
--
@@ -318,9 +297,9 @@ compileModule (RunSimplifier simplify) session ms tcg =
fmap (either (, Nothing) (second Just)) $
catchSrcErrors (hsc_dflags session) "compile" $ do
(warnings,desugared_guts) <- withWarnings "compile" $ \tweak -> do
- let ms' = tweak ms
- session' = session{ hsc_dflags = ms_hspp_opts ms'}
- desugar <- hscDesugar session' ms' tcg
+ let session' = tweak (hscSetFlags (ms_hspp_opts ms) session)
+ -- TODO: maybe settings ms_hspp_opts is unnecessary?
+ desugar <- hscDesugar session' (ms { ms_hspp_opts = hsc_dflags session' }) tcg
if simplify
then do
plugins <- readIORef (tcg_th_coreplugins tcg)
@@ -337,23 +316,20 @@ generateObjectCode session summary guts = do
fp = replaceExtension dot_o "s"
createDirectoryIfMissing True (takeDirectory fp)
(warnings, dot_o_fp) <-
- withWarnings "object" $ \_tweak -> do
- let summary' = _tweak summary
-#if MIN_VERSION_ghc(8,10,0)
- target = defaultObjectTarget $ hsc_dflags session
-#else
- target = defaultObjectTarget $ targetPlatform $ hsc_dflags session
-#endif
- session' = session { hsc_dflags = updOptLevel 0 $ (ms_hspp_opts summary') { outputFile = Just dot_o , hscTarget = target}}
+ withWarnings "object" $ \tweak -> do
+ let env' = tweak (hscSetFlags (ms_hspp_opts summary) session)
+ target = platformDefaultBackend (hsc_dflags env')
+ newFlags = setBackend target $ updOptLevel 0 $ (hsc_dflags env') { outputFile = Just dot_o }
+ session' = hscSetFlags newFlags session
#if MIN_VERSION_ghc(9,0,1)
(outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts
#else
(outputFilename, _mStub, _foreign_files) <- hscGenHardCode session' guts
#endif
#if MIN_VERSION_ghc(8,10,0)
- (ms_location summary')
+ (ms_location summary)
#else
- summary'
+ summary
#endif
fp
compileFile session' StopLn (outputFilename, Just (As False))
@@ -370,8 +346,9 @@ generateByteCode hscEnv summary guts = do
catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do
(warnings, (_, bytecode, sptEntries)) <-
withWarnings "bytecode" $ \_tweak -> do
- let summary' = _tweak summary
- session = hscEnv { hsc_dflags = ms_hspp_opts summary' }
+ 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
#if MIN_VERSION_ghc(8,10,0)
(ms_location summary')
@@ -475,16 +452,16 @@ generateHieAsts hscEnv tcm =
-- These varBinds use unitDataConId but it could be anything as the id name is not used
-- during the hie file generation process. It's a workaround for the fact that the hie modules
-- don't export an interface which allows for additional information to be added to hie files.
- let fake_splice_binds = listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm))
+ let fake_splice_binds = Util.listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm))
real_binds = tcg_binds $ tmrTypechecked tcm
#if MIN_VERSION_ghc(9,0,1)
ts = tmrTypechecked tcm :: TcGblEnv
- top_ev_binds = tcg_ev_binds ts :: Bag EvBind
+ top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind
insts = tcg_insts ts :: [ClsInst]
tcs = tcg_tcs ts :: [TyCon]
- Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs
+ Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs
#else
- Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm)
+ Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm)
#endif
where
dflags = hsc_dflags hscEnv
@@ -527,7 +504,7 @@ spliceExpresions Splices{..} =
-- TVar to 0 in order to set it up for a fresh indexing session. Otherwise, we
-- can just increment the 'indexCompleted' TVar and exit.
--
-indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Fingerprint -> Compat.HieFile -> IO ()
+indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Util.Fingerprint -> Compat.HieFile -> IO ()
indexHieFile se mod_summary srcPath !hash hf = do
IdeOptions{optProgressStyle} <- getIdeOptionsIO se
atomically $ do
@@ -565,7 +542,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
case lspEnv se of
Nothing -> pure Nothing
Just env -> LSP.runLspT env $ do
- u <- LSP.ProgressTextToken . T.pack . show . hashUnique <$> liftIO newUnique
+ u <- LSP.ProgressTextToken . T.pack . show . hashUnique <$> liftIO Unique.newUnique
-- TODO: Wait for the progress create response to use the token
_ <- LSP.sendRequest LSP.SWindowWorkDoneProgressCreate (LSP.WorkDoneProgressCreateParams u) (const $ pure ())
LSP.sendNotification LSP.SProgress $ LSP.ProgressParams u $
@@ -634,7 +611,7 @@ writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source =
hf <- runHsc hscEnv $
GHC.mkHieFile' mod_summary exports ast source
atomicFileWrite targetPath $ flip GHC.writeHieFile hf
- hash <- getFileHash targetPath
+ hash <- Util.getFileHash targetPath
indexHieFile se mod_summary srcPath hash hf
where
dflags = hsc_dflags hscEnv
@@ -645,7 +622,7 @@ writeHiFile :: HscEnv -> HiFileResult -> IO [FileDiagnostic]
writeHiFile hscEnv tc =
handleGenerationErrors dflags "interface write" $ do
atomicFileWrite targetPath $ \fp ->
- writeIfaceFile dflags fp modIface
+ writeIfaceFile hscEnv fp modIface
where
modIface = hm_iface $ hirHomeMod tc
targetPath = ml_hi_file $ ms_location $ hirModSummary tc
@@ -674,7 +651,7 @@ setupFinderCache mss session = do
-- Make modules available for others that import them,
-- by putting them in the finder cache.
- let ims = map (installedModule (thisInstalledUnitId $ hsc_dflags session) . moduleName . ms_mod) mss
+ let ims = map (installedModule (homeUnitId_ $ hsc_dflags session) . moduleName . ms_mod) mss
ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) mss ims
-- set the target and module graph in the session
graph = mkModuleGraph mss
@@ -718,7 +695,7 @@ getModSummaryFromImports
:: HscEnv
-> FilePath
-> UTCTime
- -> Maybe SB.StringBuffer
+ -> Maybe Util.StringBuffer
-> ExceptT [FileDiagnostic] IO ModSummaryResult
getModSummaryFromImports env fp modTime contents = do
(contents, opts, dflags) <- preprocessor env fp contents
@@ -730,7 +707,7 @@ getModSummaryFromImports env fp modTime contents = do
let mb_mod = hsmodName hsmod
imps = hsmodImports hsmod
- mod = fmap unLoc mb_mod `orElse` mAIN_NAME
+ mod = fmap unLoc mb_mod `Util.orElse` mAIN_NAME
(src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource.unLoc) imps
@@ -756,7 +733,7 @@ getModSummaryFromImports env fp modTime contents = do
modLoc <- liftIO $ mkHomeModLocation dflags mod fp
- let modl = mkModule (thisPackage dflags) mod
+ let modl = mkHomeModule (hscHomeUnit (hscSetFlags dflags env)) mod
sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile
msrModSummary =
ModSummary
@@ -785,14 +762,14 @@ getModSummaryFromImports env fp modTime contents = do
-- eliding the timestamps, the preprocessed source and other non relevant fields
computeFingerprint opts ModSummary{..} = do
fingerPrintImports <- fingerprintFromPut $ do
- put $ uniq $ moduleNameFS $ moduleName ms_mod
+ put $ Util.uniq $ moduleNameFS $ moduleName ms_mod
forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
- put $ uniq $ moduleNameFS $ unLoc m
- whenJust mb_p $ put . uniq
- return $! fingerprintFingerprints $
- [ fingerprintString fp
+ put $ Util.uniq $ moduleNameFS $ unLoc m
+ whenJust mb_p $ put . Util.uniq
+ return $! Util.fingerprintFingerprints $
+ [ Util.fingerprintString fp
, fingerPrintImports
- ] ++ map fingerprintString opts
+ ] ++ map Util.fingerprintString opts
-- | Parse only the module header
@@ -800,15 +777,15 @@ parseHeader
:: Monad m
=> DynFlags -- ^ flags to use
-> FilePath -- ^ the filename (for source locations)
- -> SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
+ -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
#if MIN_VERSION_ghc(9,0,1)
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule))
#else
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
#endif
parseHeader dflags filename contents = do
- let loc = mkRealSrcLoc (mkFastString filename) 1 1
- case unP Parser.parseHeader (mkPState dflags contents loc) of
+ let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1
+ case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of
#if MIN_VERSION_ghc(8,10,0)
PFailed pst ->
throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags
@@ -828,9 +805,9 @@ parseHeader dflags filename contents = do
-- errors are those from which a parse tree just can't
-- be produced.
unless (null errs) $
- throwE $ diagFromErrMsgs "parser" dflags errs
+ throwE $ diagFromErrMsgs "parser" dflags (fmap pprError errs)
- let warnings = diagFromErrMsgs "parser" dflags warns
+ let warnings = diagFromErrMsgs "parser" dflags (fmap pprWarning warns)
return (warnings, rdr_module)
-- | Given a buffer, flags, and file path, produce a
@@ -843,10 +820,10 @@ parseFileContents
-> ModSummary
-> ExceptT [FileDiagnostic] IO ([FileDiagnostic], ParsedModule)
parseFileContents env customPreprocessor filename ms = do
- let loc = mkRealSrcLoc (mkFastString filename) 1 1
+ let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1
dflags = ms_hspp_opts ms
contents = fromJust $ ms_hspp_buf ms
- case unP Parser.parseModule (mkPState dflags contents loc) of
+ case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of
#if MIN_VERSION_ghc(8,10,0)
PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags
#else
@@ -854,21 +831,8 @@ parseFileContents env customPreprocessor filename ms = do
throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
#endif
POk pst rdr_module ->
- let hpm_annotations :: ApiAnns
- hpm_annotations =
-#if MIN_VERSION_ghc(9,0,1)
- -- Copied from GHC.Driver.Main
- ApiAnns {
- apiAnnItems = Map.fromListWith (++) $ annotations pst,
- apiAnnEofPos = eof_pos pst,
- apiAnnComments = Map.fromList (annotations_comments pst),
- apiAnnRogueComments = comment_q pst
- }
-#else
- (Map.fromListWith (++) $ annotations pst,
- Map.fromList ((noSrcSpan,comment_q pst)
- :annotations_comments pst))
-#endif
+ let
+ hpm_annotations = mkApiAnns pst
(warns, errs) = getMessages pst dflags
in
do
@@ -908,7 +872,7 @@ parseFileContents env customPreprocessor filename ms = do
$ filter (/= n_hspp)
$ map normalise
$ filter (not . isPrefixOf "<")
- $ map unpackFS
+ $ map Util.unpackFS
$ srcfiles pst
srcs1 = case ml_hs_file (ms_location ms) of
Just f -> filter (/= normalise f) srcs0
@@ -919,13 +883,7 @@ parseFileContents env customPreprocessor filename ms = do
-- filter them out:
srcs2 <- liftIO $ filterM doesFileExist srcs1
- let pm =
- ParsedModule {
- pm_mod_summary = ms
- , pm_parsed_source = parsed'
- , pm_extra_src_files = srcs2
- , pm_annotations = hpm_annotations
- }
+ let pm = mkParsedModule ms parsed' srcs2 hpm_annotations
warnings = diagFromErrMsgs "parser" dflags warns
pure (warnings ++ preproc_warnings, pm)
@@ -944,7 +902,7 @@ loadInterface
-> (Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult)) -- ^ Action to regenerate an interface
-> m ([FileDiagnostic], Maybe HiFileResult)
loadInterface session ms sourceMod linkableNeeded regen = do
- let sessionWithMsDynFlags = session{hsc_dflags = ms_hspp_opts ms}
+ let sessionWithMsDynFlags = hscSetFlags (ms_hspp_opts ms) session
res <- liftIO $ checkOldIface sessionWithMsDynFlags ms sourceMod Nothing
case res of
(UpToDate, Just iface)
@@ -1019,7 +977,7 @@ getDocsBatch hsc_env _mod _names = do
UnhelpfulLoc {} -> True
fakeSpan :: RealSrcSpan
-fakeSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<ghcide>") 1 1
+fakeSpan = realSrcLocSpan $ mkRealSrcLoc (Util.fsLit "<ghcide>") 1 1
-- | Non-interactive, batch version of 'InteractiveEval.lookupNames'.
-- 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 544a88e7d7a871f8c39b41907b33baf379f9431a..29fe43296e16be370965d99022716b453a64f20a 100644
--- a/ghcide/src/Development/IDE/Core/Preprocessor.hs
+++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs
@@ -7,13 +7,13 @@ module Development.IDE.Core.Preprocessor
import Development.IDE.GHC.CPP
import Development.IDE.GHC.Compat
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Orphans ()
-import GhcMonad
-import StringBuffer as SB
import Control.DeepSeq (NFData (rnf))
import Control.Exception (evaluate)
import Control.Exception.Safe (catch, throw)
+import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Char
import Data.IORef (IORef, modifyIORef,
@@ -26,56 +26,52 @@ import Development.IDE.GHC.Error
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import qualified GHC.LanguageExtensions as LangExt
-import qualified HeaderInfo as Hdr
-import HscTypes (HscEnv (hsc_dflags))
-import Outputable (showSDoc)
-import SysTools (Option (..), runPp,
- runUnlit)
import System.FilePath
import System.IO.Extra
-
-- | Given a file and some contents, apply any necessary preprocessors,
-- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
-preprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> ExceptT [FileDiagnostic] IO (StringBuffer, [String], DynFlags)
-preprocessor env filename mbContents = do
+preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], DynFlags)
+preprocessor env0 filename mbContents = do
-- Perform unlit
(isOnDisk, contents) <-
if isLiterate filename then do
- let dflags = hsc_dflags env
- newcontent <- liftIO $ runLhs dflags filename mbContents
+ newcontent <- liftIO $ runLhs env0 filename mbContents
return (False, newcontent)
else do
- contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents
+ contents <- liftIO $ maybe (Util.hGetStringBuffer filename) return mbContents
let isOnDisk = isNothing mbContents
return (isOnDisk, contents)
-- Perform cpp
- (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents
+ (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env0 filename contents
+ let env1 = hscSetFlags dflags env0
+ let logger = hsc_logger env1
(isOnDisk, contents, opts, dflags) <-
if not $ xopt LangExt.Cpp dflags then
return (isOnDisk, contents, opts, dflags)
else do
cppLogs <- liftIO $ newIORef []
+ let newLogger = pushLogHook (const (logActionCompat $ logAction cppLogs)) logger
contents <- ExceptT
- $ (Right <$> (runCpp dflags {log_action = logActionCompat $ logAction cppLogs} filename
+ $ (Right <$> (runCpp (putLogHook newLogger env1) filename
$ if isOnDisk then Nothing else Just contents))
`catch`
- ( \(e :: GhcException) -> do
+ ( \(e :: Util.GhcException) -> do
logs <- readIORef cppLogs
case diagsFromCPPLogs filename (reverse logs) of
[] -> throw e
diags -> return $ Left diags
)
- (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents
+ (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents
return (False, contents, opts, dflags)
-- Perform preprocessor
if not $ gopt Opt_Pp dflags then
return (contents, opts, dflags)
else do
- contents <- liftIO $ runPreprocessor dflags filename $ if isOnDisk then Nothing else Just contents
- (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents
+ contents <- liftIO $ runPreprocessor env1 filename $ if isOnDisk then Nothing else Just contents
+ (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents
return (contents, opts, dflags)
where
logAction :: IORef [CPPLog] -> LogActionCompat
@@ -107,7 +103,7 @@ diagsFromCPPLogs filename logs =
-- informational log messages and attaches them to the initial log message.
go :: [CPPDiag] -> [CPPLog] -> [CPPDiag]
go acc [] = reverse $ map (\d -> d {cdMessage = reverse $ cdMessage d}) acc
- go acc (CPPLog sev (OldRealSrcSpan span) msg : logs) =
+ go acc (CPPLog sev (RealSrcSpan span _) msg : logs) =
let diag = CPPDiag (realSrcSpanToRange span) (toDSeverity sev) [msg]
in go (diag : acc) logs
go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : logs) =
@@ -134,22 +130,22 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"]
parsePragmasIntoDynFlags
:: HscEnv
-> FilePath
- -> SB.StringBuffer
+ -> Util.StringBuffer
-> IO (Either [FileDiagnostic] ([String], DynFlags))
parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do
- let opts = Hdr.getOptions dflags0 contents fp
+ let opts = getOptions dflags0 contents fp
-- Force bits that might keep the dflags and stringBuffer alive unnecessarily
evaluate $ rnf opts
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
- dflags' <- initializePlugins env dflags
- return (map unLoc opts, disableWarningsAsErrors dflags')
+ hsc_env' <- initializePlugins (hscSetFlags dflags env)
+ return (map unLoc opts, disableWarningsAsErrors (hsc_dflags hsc_env'))
where dflags0 = hsc_dflags env
-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
-runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
-runLhs dflags filename contents = withTempDir $ \dir -> do
+runLhs :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
+runLhs env filename contents = withTempDir $ \dir -> do
let fout = dir </> takeFileName filename <.> "unlit"
filesrc <- case contents of
Nothing -> return filename
@@ -159,14 +155,17 @@ runLhs dflags filename contents = withTempDir $ \dir -> do
hPutStringBuffer h cnts
return fsrc
unlit filesrc fout
- SB.hGetStringBuffer fout
+ Util.hGetStringBuffer fout
where
- unlit filein fileout = SysTools.runUnlit dflags (args filein fileout)
+ logger = hsc_logger env
+ dflags = hsc_dflags env
+
+ unlit filein fileout = runUnlit logger dflags (args filein fileout)
args filein fileout = [
- SysTools.Option "-h"
- , SysTools.Option (escape filename) -- name this file
- , SysTools.FileOption "" filein -- input file
- , SysTools.FileOption "" fileout ] -- output file
+ Option "-h"
+ , Option (escape filename) -- name this file
+ , FileOption "" filein -- input file
+ , FileOption "" fileout ] -- output file
-- taken from ghc's DriverPipeline.hs
escape ('\\':cs) = '\\':'\\': escape cs
escape ('\"':cs) = '\\':'\"': escape cs
@@ -175,31 +174,32 @@ runLhs dflags filename contents = withTempDir $ \dir -> do
escape [] = []
-- | Run CPP on a file
-runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
-runCpp dflags filename contents = withTempDir $ \dir -> do
+runCpp :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
+runCpp env0 filename contents = withTempDir $ \dir -> do
let out = dir </> takeFileName filename <.> "out"
- dflags <- pure $ addOptP "-D__GHCIDE__" dflags
+ let dflags1 = addOptP "-D__GHCIDE__" (hsc_dflags env0)
+ let env1 = hscSetFlags dflags1 env0
case contents of
Nothing -> 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 dflags True filename out
- liftIO $ SB.hGetStringBuffer out
+ doCpp env1 True filename out
+ liftIO $ Util.hGetStringBuffer out
Just contents -> do
-- Sad path, we have to create a version of the path in a temp dir
-- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
-- Relative includes aren't going to work, so we fix that by adding to the include path.
- dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags
-
+ let dflags2 = addIncludePathsQuote (takeDirectory filename) dflags1
+ let env2 = hscSetFlags dflags2 env0
-- Location information is wrong, so we fix that by patching it afterwards.
let inp = dir </> "___GHCIDE_MAGIC___"
withBinaryFile inp WriteMode $ \h ->
hPutStringBuffer h contents
- doCpp dflags True inp out
+ doCpp env2 True inp out
-- Fix up the filename in lines like:
-- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
@@ -211,12 +211,12 @@ runCpp dflags filename contents = withTempDir $ \dir -> do
-- and GHC gets all confused
= "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""
| otherwise = x
- stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
+ Util.stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
-- | Run a preprocessor on a file
-runPreprocessor :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
-runPreprocessor dflags filename contents = withTempDir $ \dir -> do
+runPreprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer
+runPreprocessor env filename contents = withTempDir $ \dir -> do
let out = dir </> takeFileName filename <.> "out"
inp <- case contents of
Nothing -> return filename
@@ -225,5 +225,8 @@ runPreprocessor dflags filename contents = withTempDir $ \dir -> do
withBinaryFile inp WriteMode $ \h ->
hPutStringBuffer h contents
return inp
- runPp dflags [SysTools.Option filename, SysTools.Option inp, SysTools.FileOption "" out]
- SB.hGetStringBuffer out
+ runPp logger dflags [Option filename, Option inp, FileOption "" out]
+ Util.hGetStringBuffer out
+ where
+ logger = hsc_logger env
+ dflags = hsc_dflags env
diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs
index 0b19fc85a473e059ec673e10a09692f5f59ade45..abbc7c6cf3825cd258ae5b3f8fb495ba9c67403f 100644
--- a/ghcide/src/Development/IDE/Core/RuleTypes.hs
+++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs
@@ -25,6 +25,7 @@ import Data.Time.Clock.POSIX
import Data.Typeable
import Development.IDE.GHC.Compat hiding
(HieFileResult)
+import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Util
import Development.IDE.Graph
import Development.IDE.Import.DependencyInformation
@@ -32,11 +33,6 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq)
import Development.IDE.Types.KnownTargets
import GHC.Generics (Generic)
-import HscTypes (HomeModInfo,
- ModGuts,
- hm_iface,
- hm_linkable)
-
import qualified Data.Binary as B
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
@@ -46,10 +42,8 @@ import Development.IDE.Import.FindImports (ArtifactsLocation
import Development.IDE.Spans.Common
import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.Diagnostics
-import Fingerprint
import GHC.Serialized (Serialized)
import Language.LSP.Types (NormalizedFilePath)
-import TcRnMonad (TcGblEnv)
data LinkableType = ObjectLinkable | BCOLinkable
deriving (Eq,Ord,Show, Generic)
diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
index 0d4c08293195cc96cf7474fcdca875b46cade443..d4f4c30d811987d4301d4494dc71bd7622e47bd0 100644
--- a/ghcide/src/Development/IDE/Core/Rules.hs
+++ b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -58,6 +58,9 @@ module Development.IDE.Core.Rules(
typeCheckRuleDefinition,
) where
+#if !MIN_VERSION_ghc(8,8,0)
+import Control.Applicative (liftA2)
+#endif
import Control.Concurrent.Async (concurrently)
import Control.Concurrent.Strict
import Control.Exception.Safe
@@ -103,12 +106,14 @@ import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
-import Development.IDE.GHC.Compat hiding
- (TargetFile,
- TargetModule,
- parseModule,
- typecheckModule,
- writeHieFile)
+import Development.IDE.GHC.Compat.Env
+import Development.IDE.GHC.Compat.Core hiding
+ (parseModule,
+ TargetId(..),
+ loadInterface,
+ Var)
+import qualified Development.IDE.GHC.Compat as Compat
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.GHC.Util hiding
@@ -125,23 +130,16 @@ import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import qualified Development.IDE.Types.Logger as L
import Development.IDE.Types.Options
-import Fingerprint
import GHC.Generics (Generic)
import GHC.IO.Encoding
import qualified GHC.LanguageExtensions as LangExt
import qualified HieDb
-import HscTypes hiding
- (TargetFile,
- TargetModule)
import Ide.Plugin.Config
import qualified Language.LSP.Server as LSP
import Language.LSP.Types (SMethod (SCustomMethod))
import Language.LSP.VFS
-import Module
import System.Directory (canonicalizePath, makeAbsolute)
-import TcRnMonad (tcg_dependent_files)
-import Control.Applicative
import Data.Default (def)
import Ide.Plugin.Properties (HasProperty,
KeyNameProxy,
@@ -343,7 +341,7 @@ getLocatedImportsRule =
| otherwise
= return Nothing
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
- diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
+ diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
case diagOrImp of
Left diags -> pure (diags, Just (modName, Nothing))
Right (FileImport path) -> pure ([], Just (modName, Just path))
@@ -503,8 +501,8 @@ getDependenciesRule =
let allFiles = reachableModules depInfo
_ <- uses_ ReportImportCycles allFiles
opts <- getIdeOptions
- let mbFingerprints = map (fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts
- return (fingerprintToBS . fingerprintFingerprints <$> mbFingerprints, transitiveDeps depInfo file)
+ let mbFingerprints = map (Util.fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts
+ return (fingerprintToBS . Util.fingerprintFingerprints <$> mbFingerprints, transitiveDeps depInfo file)
getHieAstsRule :: Rules ()
getHieAstsRule =
@@ -523,9 +521,9 @@ persistentHieFileRule = addPersistentRule GetHieAst $ \file -> runMaybeT $ do
case mvf of
Nothing -> (,Nothing) . T.decode encoding <$> BS.readFile (fromNormalizedFilePath file)
Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf)
- let refmap = generateReferencesMap . getAsts . hie_asts $ res
- del = deltaFromDiff (T.decode encoding $ hie_hs_src res) currentSource
- pure (HAR (hie_module res) (hie_asts res) refmap mempty (HieFromDisk res),del,ver)
+ let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res
+ del = deltaFromDiff (T.decode encoding $ Compat.hie_hs_src res) currentSource
+ pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver)
getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition f hsc tmr = do
@@ -546,8 +544,8 @@ getHieAstRuleDefinition f hsc tmr = do
liftIO $ writeAndIndexHieFile hsc se msum f exports asts source
_ -> pure []
- let refmap = generateReferencesMap . getAsts <$> masts
- typemap = AtPoint.computeTypeReferences . getAsts <$> masts
+ let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts
+ typemap = AtPoint.computeTypeReferences . Compat.getAsts <$> masts
pure (diags <> diagsWrite, HAR (ms_mod $ tmrModSummary tmr) <$> masts <*> refmap <*> typemap <*> pure HieFresh)
getImportMapRule :: Rules ()
@@ -584,7 +582,7 @@ getDocMapRule =
persistentDocMapRule :: Rules ()
persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing)
-readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction HieFile
+readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction Compat.HieFile
readHieFileForSrcFromDisk file = do
db <- asks hiedb
log <- asks $ L.logDebug . logger
@@ -593,7 +591,7 @@ readHieFileForSrcFromDisk file = do
liftIO $ log $ "LOADING HIE FILE :" <> T.pack (show file)
exceptToMaybeT $ readHieFileFromDisk hie_loc
-readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction HieFile
+readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction Compat.HieFile
readHieFileFromDisk hie_loc = do
nc <- asks ideNc
log <- asks $ L.logDebug . logger
@@ -754,8 +752,8 @@ getModIfaceFromDiskAndIndexRule =
-- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db
let ms = hirModSummary x
- hie_loc = ml_hie_file $ ms_location ms
- hash <- liftIO $ getFileHash hie_loc
+ hie_loc = Compat.ml_hie_file $ ms_location ms
+ hash <- liftIO $ Util.getFileHash hie_loc
mrow <- liftIO $ HieDb.lookupHieFileFromSource hiedb (fromNormalizedFilePath f)
hie_loc' <- liftIO $ traverse (canonicalizePath . HieDb.hieModuleHieFile) mrow
case mrow of
@@ -785,7 +783,7 @@ isHiFileStableRule :: Rules ()
isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f -> do
ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps f
let hiFile = toNormalizedFilePath'
- $ ml_hi_file $ ms_location ms
+ $ Compat.ml_hi_file $ ms_location ms
mbHiVersion <- use GetModificationTime_{missingFileDiagnostics=False} hiFile
modVersion <- use_ GetModificationTime f
sourceModified <- case mbHiVersion of
@@ -811,7 +809,7 @@ getModSummaryRule = do
defineEarlyCutoff $ Rule $ \GetModSummary f -> do
session' <- hscEnv <$> use_ GhcSession f
modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal
- let session = session' { hsc_dflags = modify_dflags $ hsc_dflags session' }
+ let session = hscSetFlags (modify_dflags $ hsc_dflags session') session'
(modTime, mFileContent) <- getFileContents f
let fp = fromNormalizedFilePath f
modS <- liftIO $ runExceptT $
@@ -820,7 +818,7 @@ getModSummaryRule = do
Right res -> do
bufFingerPrint <- liftIO $
fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res
- let fingerPrint = fingerprintFingerprints
+ let fingerPrint = Util.fingerprintFingerprints
[ msrFingerprint res, bufFingerPrint ]
return ( Just (fingerprintToBS fingerPrint) , ([], Just res))
Left diags -> return (Nothing, (diags, Nothing))
@@ -1047,7 +1045,7 @@ instance IsIdeGlobal CompiledLinkables
writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
writeHiFileAction hsc hiFile = do
extras <- getShakeExtras
- let targetPath = ml_hi_file $ ms_location $ hirModSummary hiFile
+ let targetPath = Compat.ml_hi_file $ ms_location $ hirModSummary hiFile
liftIO $ do
resetInterfaceStore extras $ toNormalizedFilePath' targetPath
writeHiFile hsc hiFile
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 37bfa9dc6a52e9ce2d4d6689c14c34dfac3f2426..d90cf01009063aa20acba8000965fd884a787cd4 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -109,7 +109,11 @@ import Development.IDE.Core.PositionMapping
import Development.IDE.Core.ProgressReporting
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Tracing
-import Development.IDE.GHC.Compat (NameCacheUpdater (..), upNameCache)
+import Development.IDE.GHC.Compat (NameCacheUpdater (..),
+ upNameCache, NameCache,
+ initNameCache,
+ mkSplitUniqSupply,
+ knownKeyNames)
import Development.IDE.GHC.Orphans ()
import Development.IDE.Graph hiding (ShakeValue)
import qualified Development.IDE.Graph as Shake
@@ -137,10 +141,7 @@ import System.Time.Extra
import Data.IORef
import GHC.Fingerprint
import Language.LSP.Types.Capabilities
-import NameCache
import OpenTelemetry.Eventlog
-import PrelInfo
-import UniqSupply
import Control.Exception.Extra hiding (bracket_)
import qualified Data.ByteString.Char8 as BS8
diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs
index 1c773587bc1de39ab8e6a17f8c03cb6c13670f6d..546b2eae44946475458e413b4aba7b1faa319ad4 100644
--- a/ghcide/src/Development/IDE/Core/Tracing.hs
+++ b/ghcide/src/Development/IDE/Core/Tracing.hs
@@ -21,7 +21,9 @@ import Control.Monad (forM_, forever, unless, void,
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Unlift
import Control.Seq (r0, seqList, seqTuple2, using)
+#if MIN_VERSION_ghc(8,8,0)
import Data.ByteString (ByteString)
+#endif
import Data.Dynamic (Dynamic)
import qualified Data.HashMap.Strict as HMap
import Data.IORef (modifyIORef', newIORef,
diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs
index df19b47a95de6dff89980afe82bc26e4ba0572dc..55b52e39bef3739725efc7f00d9f418517c0ab41 100644
--- a/ghcide/src/Development/IDE/Core/UseStale.hs
+++ b/ghcide/src/Development/IDE/Core/UseStale.hs
@@ -29,6 +29,9 @@ import Data.Functor ((<&>))
import Data.Functor.Identity (Identity (Identity))
import Data.Kind (Type)
import Data.String (fromString)
+import Development.IDE.GHC.Compat (RealSrcSpan,
+ srcSpanFile)
+import Development.IDE.GHC.Compat.Util (unpackFS)
import Development.IDE (Action, IdeRule,
NormalizedFilePath,
Range,
@@ -36,8 +39,6 @@ import Development.IDE (Action, IdeRule,
realSrcSpanToRange)
import qualified Development.IDE.Core.PositionMapping as P
import qualified Development.IDE.Core.Shake as IDE
-import qualified FastString as FS
-import SrcLoc
------------------------------------------------------------------------------
@@ -113,7 +114,7 @@ instance MapAge Range where
instance MapAge RealSrcSpan where
mapAgeFrom =
- invMapAge (\fs -> rangeToRealSrcSpan (fromString $ FS.unpackFS fs))
+ invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs))
(srcSpanFile &&& realSrcSpanToRange)
. mapAgeFrom
diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs
index 287ce61ac4b01cc407944aaa19ae1dcde2eebd5c..ee23fb004b9b00cb9050baf733714b47949eb17c 100644
--- a/ghcide/src/Development/IDE/GHC/CPP.hs
+++ b/ghcide/src/Development/IDE/GHC/CPP.hs
@@ -1,17 +1,8 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
--- Copied from https://github.com/ghc/ghc/blob/master/compiler/main/DriverPipeline.hs on 14 May 2019
--- Requested to be exposed at https://gitlab.haskell.org/ghc/ghc/merge_requests/944.
--- Update the above MR got merged to master on 31 May 2019. When it becomes avialable to ghc-lib, this file can be removed.
-
-{- HLINT ignore -} -- since copied from upstream
-
{-# LANGUAGE CPP #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NondecreasingIndentation #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-----------------------------------------------------------------------------
--
@@ -24,148 +15,25 @@
module Development.IDE.GHC.CPP(doCpp, addOptP)
where
+import GHC
import Development.IDE.GHC.Compat as Compat
-import FileCleanup
-import Packages
-import Panic
-import SysTools
-#if MIN_VERSION_ghc(8,8,2)
-import LlvmCodeGen (llvmVersionList)
-#elif MIN_VERSION_ghc(8,8,0)
-import LlvmCodeGen (LlvmVersion (..))
+#if !MIN_VERSION_ghc(8,10,0)
+import qualified Development.IDE.GHC.Compat.CPP as CPP
+#else
+import Development.IDE.GHC.Compat.Util
#endif
+
+#if MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Driver.Pipeline as Pipeline
+import GHC.Settings
+#else
#if MIN_VERSION_ghc (8,10,0)
-import Fingerprint
+import qualified DriverPipeline as Pipeline
import ToolSettings
-#endif
-
-import Control.Monad
-import Data.List (intercalate)
-import Data.Maybe
-import Data.Version
-import System.Directory
-import System.FilePath
-import System.Info
-
-
-
-doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
-doCpp dflags raw input_fn output_fn = do
- let hscpp_opts = picPOpts dflags
- let cmdline_include_paths = includePaths dflags
-
- pkg_include_dirs <- getPackageIncludePath dflags []
- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
- (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
- (includePathsQuote cmdline_include_paths)
- let include_paths = include_paths_quote ++ include_paths_global
-
- let verbFlags = getVerbFlags dflags
-
- let cpp_prog args | raw = SysTools.runCpp dflags args
-#if MIN_VERSION_ghc(8,10,0)
- | otherwise = SysTools.runCc Nothing
#else
- | otherwise = SysTools.runCc
+import DynFlags
#endif
- dflags (SysTools.Option "-E" : args)
-
- let target_defs =
- -- NEIL: Patched to use System.Info instead of constants from CPP
- [ "-D" ++ os ++ "_BUILD_OS",
- "-D" ++ arch ++ "_BUILD_ARCH",
- "-D" ++ os ++ "_HOST_OS",
- "-D" ++ arch ++ "_HOST_ARCH" ]
- -- remember, in code we *compile*, the HOST is the same our TARGET,
- -- and BUILD is the same as our HOST.
-
- let sse_defs =
- [ "-D__SSE__" | isSseEnabled dflags ] ++
- [ "-D__SSE2__" | isSse2Enabled dflags ] ++
- [ "-D__SSE4_2__" | isSse4_2Enabled dflags ]
-
- let avx_defs =
- [ "-D__AVX__" | isAvxEnabled dflags ] ++
- [ "-D__AVX2__" | isAvx2Enabled dflags ] ++
- [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++
- [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++
- [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++
- [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]
-
- backend_defs <- getBackendDefs dflags
-
- let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
- -- Default CPP defines in Haskell source
- ghcVersionH <- getGhcVersionPathName dflags
- let hsSourceCppOpts = [ "-include", ghcVersionH ]
-
- -- MIN_VERSION macros
- let uids = explicitPackages (pkgState dflags)
- pkgs = catMaybes (map (lookupPackage dflags) uids)
- mb_macro_include <-
- if not (null pkgs) && gopt Opt_VersionMacros dflags
- then do macro_stub <- newTempName dflags TFL_CurrentModule "h"
- writeFile macro_stub (generatePackageVersionMacros pkgs)
- -- Include version macros for every *exposed* package.
- -- Without -hide-all-packages and with a package database
- -- size of 1000 packages, it takes cpp an estimated 2
- -- milliseconds to process this file. See #10970
- -- comment 8.
- return [SysTools.FileOption "-include" macro_stub]
- else return []
-
- cpp_prog ( map SysTools.Option verbFlags
- ++ map SysTools.Option include_paths
- ++ map SysTools.Option hsSourceCppOpts
- ++ map SysTools.Option target_defs
- ++ map SysTools.Option backend_defs
- ++ map SysTools.Option th_defs
- ++ map SysTools.Option hscpp_opts
- ++ map SysTools.Option sse_defs
- ++ map SysTools.Option avx_defs
- ++ mb_macro_include
- -- Set the language mode to assembler-with-cpp when preprocessing. This
- -- alleviates some of the C99 macro rules relating to whitespace and the hash
- -- operator, which we tend to abuse. Clang in particular is not very happy
- -- about this.
- ++ [ SysTools.Option "-x"
- , SysTools.Option "assembler-with-cpp"
- , SysTools.Option input_fn
- -- We hackily use Option instead of FileOption here, so that the file
- -- name is not back-slashed on Windows. cpp is capable of
- -- dealing with / in filenames, so it works fine. Furthermore
- -- if we put in backslashes, cpp outputs #line directives
- -- with *double* backslashes. And that in turn means that
- -- our error messages get double backslashes in them.
- -- In due course we should arrange that the lexer deals
- -- with these \\ escapes properly.
- , SysTools.Option "-o"
- , SysTools.FileOption "" output_fn
- ])
-
-getBackendDefs :: DynFlags -> IO [String]
-getBackendDefs dflags | hscTarget dflags == HscLlvm = do
- llvmVer <- figureLlvmVersion dflags
- return $ case llvmVer of
-#if MIN_VERSION_ghc(8,8,2)
- Just v
- | [m] <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, 0) ]
- | m:n:_ <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, n) ]
-#elif MIN_VERSION_ghc(8,8,0)
- Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ]
- Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]
-#else
- Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ]
#endif
- _ -> []
- where
- format (major, minor)
- | minor >= 100 = error "getBackendDefs: Unsupported minor version"
- | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int
-
-getBackendDefs _ =
- return []
addOptP :: String -> DynFlags -> DynFlags
#if MIN_VERSION_ghc (8,10,0)
@@ -183,47 +51,13 @@ addOptP opt = onSettings (onOptP (opt:))
onOptP f x = x{sOpt_P = f $ sOpt_P x}
#endif
--- ---------------------------------------------------------------------------
--- Macros (cribbed from Cabal)
-
-generatePackageVersionMacros :: [Compat.PackageConfig] -> String
-generatePackageVersionMacros pkgs = concat
- -- Do not add any C-style comments. See #3389.
- [ generateMacros "" pkgname version
- | pkg <- pkgs
- , let version = packageVersion pkg
- pkgname = map fixchar (packageNameString pkg)
- ]
-
-fixchar :: Char -> Char
-fixchar '-' = '_'
-fixchar c = c
-
-generateMacros :: String -> String -> Version -> String
-generateMacros prefix name version =
- concat
- ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n"
- ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
- ," (major1) < ",major1," || \\\n"
- ," (major1) == ",major1," && (major2) < ",major2," || \\\n"
- ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
- ,"\n\n"
- ]
- where
- (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
-
-
--- | Find out path to @ghcversion.h@ file
-getGhcVersionPathName :: DynFlags -> IO FilePath
-getGhcVersionPathName dflags = do
- candidates <- case ghcVersionFile dflags of
- Just path -> return [path]
- Nothing -> (map (</> "ghcversion.h")) <$>
- (getPackageIncludePath dflags [Compat.toInstalledUnitId Compat.rtsUnit])
+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
+#elif MIN_VERSION_ghc (8,10,0)
+ Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn
+#else
+ CPP.doCpp (hsc_dflags env) raw input_fn output_fn
+#endif
- found <- filterM doesFileExist candidates
- case found of
- [] -> throwGhcExceptionIO (InstallationError
- ("ghcversion.h missing; tried: "
- ++ intercalate ", " candidates))
- (x:_) -> return x
diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs
index d5e8dd9e29c87cbc4d98c403e8c216deeb9fee1b..79840ba37fb77e2cbd5988633094db930fc58634 100644
--- a/ghcide/src/Development/IDE/GHC/Compat.hs
+++ b/ghcide/src/Development/IDE/GHC/Compat.hs
@@ -4,218 +4,122 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# OPTIONS -Wno-dodgy-imports -Wno-incomplete-uni-patterns #-}
-{-# OPTIONS -Wno-missing-signatures #-} -- TODO: Remove!
+{-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-}
-- | Attempt at hiding the GHC version differences we can.
module Development.IDE.GHC.Compat(
- HieFileResult(..),
- HieFile(..),
NameCacheUpdater(..),
- hieExportNames,
- mkHieFile',
- enrichHie,
- writeHieFile,
- readHieFile,
- supportsHieFiles,
- setHieDir,
- dontWriteHieFiles,
-#if !MIN_VERSION_ghc(8,8,0)
- ml_hie_file,
- addBootSuffixLocnOut,
- getRealSrcSpan,
-#endif
hPutStringBuffer,
addIncludePathsQuote,
getModuleHash,
- getPackageName,
setUpTypedHoles,
- GHC.ModLocation,
- Module.addBootSuffix,
- pattern ModLocation,
- pattern ExposePackage,
- HasSrcSpan,
- getLoc,
upNameCache,
disableWarningsAsErrors,
- AvailInfo,
- tcg_exports,
- pattern FunTy,
-
-#if MIN_VERSION_ghc(8,10,0)
- module GHC.Hs.Extension,
- module LinkerTypes,
-#else
- module HsExtension,
- noExtField,
- linkableTime,
-#endif
-#if MIN_VERSION_ghc(9,0,1)
- -- Reexports from GHC
- UnitId,
- moduleUnitId,
- pkgState,
- thisInstalledUnitId,
- -- Reexports from DynFlags
- thisPackage,
- writeIfaceFile,
-
- gcatch,
-#else
+#if !MIN_VERSION_ghc(9,0,1)
RefMap,
- Unit,
#endif
- -- Linear
- Scaled,
- scaledThing,
-
- lookupUnit',
- preloadClosureUs,
- -- Reexports from Package
- InstalledUnitId,
- PackageConfig,
- getPackageConfigMap,
- getPackageIncludePath,
- installedModule,
-
- pattern DefiniteUnitId,
- packageName,
- packageNameString,
- packageVersion,
- toInstalledUnitId,
- lookupPackage,
- -- lookupPackage',
- explicitPackages,
- exposedModules,
- packageConfigId,
- setThisInstalledUnitId,
- initUnits,
- lookupInstalledPackage,
- oldLookupInstalledPackage,
- unitDepends,
-
- haddockInterfaces,
-
- oldUnhelpfulSpan ,
- pattern IsBoot,
- pattern NotBoot,
- pattern OldRealSrcSpan,
-
- oldRenderWithStyle,
- oldMkUserStyle,
- oldMkErrStyle,
- oldFormatErrDoc,
- oldListVisibleModuleNames,
- oldLookupModuleWithSuggestions,
nodeInfo',
getNodeIds,
- stringToUnit,
- rtsUnit,
- unitString,
-
- LogActionCompat,
- logActionCompat,
-
- pprSigmaType,
- module GHC,
- module DynFlags,
- initializePlugins,
- applyPluginsParsedResultAction,
- module Compat.HieTypes,
- module Compat.HieUtils,
- dropForAll,
isQualifiedImport,
GhcVersion(..),
ghcVersion,
- ghcVersionStr
+ ghcVersionStr,
+ -- * HIE Compat
+ HieFileResult(..),
+ HieFile(..),
+ hieExportNames,
+ mkHieFile',
+ enrichHie,
+ writeHieFile,
+ readHieFile,
+ supportsHieFiles,
+ setHieDir,
+ dontWriteHieFiles,
+ module Compat.HieTypes,
+ module Compat.HieUtils,
+ -- * Compat modules
+ module Development.IDE.GHC.Compat.Core,
+ module Development.IDE.GHC.Compat.Env,
+ module Development.IDE.GHC.Compat.Iface,
+ module Development.IDE.GHC.Compat.Logger,
+ module Development.IDE.GHC.Compat.Outputable,
+ module Development.IDE.GHC.Compat.Parser,
+ module Development.IDE.GHC.Compat.Plugins,
+ module Development.IDE.GHC.Compat.Units,
+ -- * Extras that rely on compat modules
+ -- * SysTools
+ Option (..),
+ runUnlit,
+ runPp,
) where
-#if MIN_VERSION_ghc(8,10,0)
-import LinkerTypes
-#endif
+import GHC hiding (HasSrcSpan, ModLocation, getLoc,
+ lookupName, RealSrcSpan)
+import Development.IDE.GHC.Compat.Core
+import Development.IDE.GHC.Compat.Env
+import Development.IDE.GHC.Compat.Iface
+import Development.IDE.GHC.Compat.Logger
+import Development.IDE.GHC.Compat.Outputable
+import Development.IDE.GHC.Compat.Parser
+import Development.IDE.GHC.Compat.Plugins
+import Development.IDE.GHC.Compat.Units
+import Development.IDE.GHC.Compat.Util
-import DynFlags hiding (ExposePackage)
-import qualified DynFlags
-import qualified ErrUtils as Err
-import Fingerprint (Fingerprint)
-import qualified Module
-import qualified Outputable as Out
-import StringBuffer
-#if MIN_VERSION_ghc(9,0,1)
-import Control.Exception.Safe as Safe (Exception, MonadCatch, catch)
-import qualified Data.Set as S
-import GHC.Core.TyCo.Ppr (pprSigmaType)
-import GHC.Core.TyCo.Rep (Scaled, scaledThing)
-import GHC.Iface.Load
-import GHC.Types.Unique.Set (emptyUniqSet)
-import Module (unitString)
-import qualified SrcLoc
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Data.StringBuffer
+import GHC.Driver.Session hiding (ExposePackage)
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Driver.Env as Env
+import GHC.Unit.Module.ModIface
#else
-import Module (InstalledUnitId,
- UnitId (DefiniteUnitId),
- toInstalledUnitId)
-import TcType (pprSigmaType)
+import GHC.Driver.Types
#endif
-import Compat.HieAst (enrichHie)
-import Compat.HieBin
-import Compat.HieTypes
-import Compat.HieUtils
-import qualified Data.ByteString as BS
-import Data.IORef
-import HscTypes
-import MkIface
-import NameCache
-import Packages
-import TcRnTypes
-
-#if MIN_VERSION_ghc(8,10,0)
-import GHC.Hs.Extension
+import GHC.Iface.Env
+import GHC.Iface.Make (mkIfaceExports)
+import qualified GHC.SysTools.Tasks as SysTools
+import qualified GHC.Types.Avail as Avail
#else
-import HsExtension
-#endif
+import DynFlags hiding (ExposePackage)
+import HscTypes
+import MkIface hiding (writeIfaceFile)
+import qualified Avail
-import Avail
-import GHC hiding (HasSrcSpan, ModLocation, getLoc,
- lookupName)
-import qualified GHC
-import qualified TyCoRep
#if MIN_VERSION_ghc(8,8,0)
-import Data.List (foldl')
-#else
-import Data.List (foldl', isSuffixOf)
+import StringBuffer (hPutStringBuffer)
#endif
-
-import qualified Data.Map as M
-import DynamicLoading
-import Plugins (Plugin (parsedResultAction),
- withPlugins)
+import qualified SysTools
#if !MIN_VERSION_ghc(8,8,0)
import SrcLoc (RealLocated)
-import System.FilePath ((-<.>))
-#endif
-
-#if !MIN_VERSION_ghc(8,8,0)
import qualified EnumSet
import Foreign.ForeignPtr
import System.IO
+#endif
+#endif
+
+import Compat.HieAst (enrichHie)
+import Compat.HieBin
+import Compat.HieTypes
+import Compat.HieUtils
+import qualified Data.ByteString as BS
+import Data.IORef
+
+import qualified Data.Map as Map
+import Data.List (foldl')
+#if MIN_VERSION_ghc(9,0,0)
+import qualified Data.Set as S
+#endif
+#if !MIN_VERSION_ghc(8,8,0)
hPutStringBuffer :: Handle -> StringBuffer -> IO ()
hPutStringBuffer hdl (StringBuffer buf len cur)
= withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
hPutBuf hdl ptr len
-
-#endif
-
-#if !MIN_VERSION_ghc(8,10,0)
-noExtField :: NoExt
-noExtField = noExt
#endif
supportsHieFiles :: Bool
@@ -224,28 +128,20 @@ supportsHieFiles = True
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = nameListFromAvails . hie_exports
-#if !MIN_VERSION_ghc(8,8,0)
-ml_hie_file :: GHC.ModLocation -> FilePath
-ml_hie_file ml
- | "boot" `isSuffixOf ` ml_hi_file ml = ml_hi_file ml -<.> ".hie-boot"
- | otherwise = ml_hi_file ml -<.> ".hie"
-#endif
-
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
-#if !MIN_VERSION_ghc(8,8,0)
+#if MIN_VERSION_ghc(8,8,0)
+upNameCache = updNameCache
+#else
upNameCache ref upd_fn
= atomicModifyIORef' ref upd_fn
-#else
-upNameCache = updNameCache
#endif
-
#if !MIN_VERSION_ghc(9,0,1)
-type RefMap a = M.Map Identifier [(Span, IdentifierDetails a)]
+type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)]
#endif
mkHieFile' :: ModSummary
- -> [AvailInfo]
+ -> [Avail.AvailInfo]
-> HieASTs Type
-> BS.ByteString
-> Hsc HieFile
@@ -266,15 +162,6 @@ addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote path x = x{includePaths = f $ includePaths x}
where f i = i{includePathsQuote = path : includePathsQuote i}
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation
-#if MIN_VERSION_ghc(8,8,0)
-pattern ModLocation a b c <-
- GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c ""
-#else
-pattern ModLocation a b c <-
- GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c
-#endif
-
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir _f d =
#if MIN_VERSION_ghc(8,8,0)
@@ -312,45 +199,10 @@ setUpTypedHoles df
}
-nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
+nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails as =
- map (\n -> (nameSrcSpan n, n)) (concatMap availNames as)
-
-#if MIN_VERSION_ghc(9,0,0)
--- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x)
--- type HasSrcSpan x = () :: Constraint
+ map (\n -> (nameSrcSpan n, n)) (concatMap Avail.availNames as)
-class HasSrcSpan a where
- getLoc :: a -> SrcSpan
-
-instance HasSrcSpan (GenLocated SrcSpan a) where
- getLoc = GHC.getLoc
-
--- getLoc :: GenLocated l a -> l
--- getLoc = GHC.getLoc
-
-#elif MIN_VERSION_ghc(8,8,0)
-type HasSrcSpan = GHC.HasSrcSpan
-getLoc :: HasSrcSpan a => a -> SrcSpan
-getLoc = GHC.getLoc
-
-#else
-
-class HasSrcSpan a where
- getLoc :: a -> SrcSpan
-instance HasSrcSpan Name where
- getLoc = nameSrcSpan
-instance HasSrcSpan (GenLocated SrcSpan a) where
- getLoc = GHC.getLoc
-
--- | Add the @-boot@ suffix to all output file paths associated with the
--- module, not including the input file itself
-addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation
-addBootSuffixLocnOut locn
- = locn { ml_hi_file = Module.addBootSuffix (ml_hi_file locn)
- , ml_obj_file = Module.addBootSuffix (ml_obj_file locn)
- }
-#endif
getModuleHash :: ModIface -> Fingerprint
#if MIN_VERSION_ghc(8,10,0)
@@ -359,137 +211,6 @@ getModuleHash = mi_mod_hash . mi_final_exts
getModuleHash = mi_mod_hash
#endif
--- type PackageName = Packages.PackageName
-#if MIN_VERSION_ghc(9,0,0)
--- NOTE: Since both the new and old version uses UnitId with different meaning,
--- we try to avoid it and instead use InstalledUnitId and Unit, since it is unambiguous.
-type UnitId = Module.Unit
-type InstalledUnitId = Module.UnitId
-type PackageConfig = Packages.UnitInfo
-pattern DefiniteUnitId x = Module.RealUnit x
-definiteUnitId = Module.RealUnit
-defUnitId = Module.Definite
-installedModule = Module.Module
--- pattern InstalledModule a b = Module.Module a b
-packageName = Packages.unitPackageName
-lookupPackage = Packages.lookupUnit . unitState
--- lookupPackage' = undefined
--- lookupPackage' b pm u = Packages.lookupUnit' b pm undefined u
--- lookupPackage' b pm u = Packages.lookupUnit' b pm emptyUniqSet u -- TODO: Is this correct?
--- lookupPackage' = fmap Packages.lookupUnit' . unitState
-getPackageConfigMap = Packages.unitInfoMap . unitState
-preloadClosureUs = Packages.preloadClosure . unitState
--- getPackageConfigMap = unitState
--- getPackageIncludePath = undefined
-getPackageIncludePath = Packages.getUnitIncludePath
-explicitPackages = Packages.explicitUnits
-pkgState = GHC.unitState
-packageNameString = Packages.unitPackageNameString
-packageVersion = Packages.unitPackageVersion
--- toInstalledUnitId = id -- Module.toUnitId -- TODO: This is probably wrong
-toInstalledUnitId = Module.toUnitId
-exposedModules = Packages.unitExposedModules
-packageConfigId = Packages.mkUnit
-moduleUnitId = Module.moduleUnit
-lookupInstalledPackage = Packages.lookupUnitId
-oldLookupInstalledPackage = Packages.lookupUnitId . unitState
--- initUnits = Packages.initUnits
--- initPackages = initPackagesx
-haddockInterfaces = unitHaddockInterfaces
-
-thisInstalledUnitId = GHC.homeUnitId
-thisPackage = DynFlags.homeUnit
-setThisInstalledUnitId uid df = df { homeUnitId = uid}
-
-oldUnhelpfulSpan = UnhelpfulSpan . SrcLoc.UnhelpfulOther
--- unhelpfulOther = unhelpfulOther . _
-pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan
-pattern OldRealSrcSpan x <- RealSrcSpan x _ where
- OldRealSrcSpan x = RealSrcSpan x Nothing
-{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-}
-
-oldListVisibleModuleNames = Packages.listVisibleModuleNames . unitState
-oldLookupModuleWithSuggestions = Packages.lookupModuleWithSuggestions . unitState
--- oldLookupInPackageDB = Packages.lookupInPackageDB . unitState
-
-oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc
-oldMkUserStyle _ = Out.mkUserStyle
-oldMkErrStyle _ = Out.mkErrStyle
-
--- TODO: This is still a mess!
-oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
-oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext
- where dummySDocContext = initSDocContext dflags Out.defaultUserStyle
--- oldFormatErrDoc = Err.formatErrDoc . undefined
-writeIfaceFile = writeIface
-
-type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO ()
-
--- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test.
-logActionCompat :: LogActionCompat -> LogAction
-logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify
-
--- We are using Safe here, which is not equivalent, but probably what we want.
-gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a
-gcatch = Safe.catch
-
-#else
-
-type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO ()
-
-logActionCompat :: LogActionCompat -> LogAction
-logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (Out.queryQual style)
-
-type Unit = Module.UnitId
--- type PackageConfig = Packages.PackageConfig
-definiteUnitId :: Module.DefUnitId -> UnitId
-definiteUnitId = Module.DefiniteUnitId
-defUnitId :: InstalledUnitId -> Module.DefUnitId
-defUnitId = Module.DefUnitId
-installedModule :: InstalledUnitId -> ModuleName -> Module.InstalledModule
-installedModule = Module.InstalledModule
-oldLookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
-oldLookupInstalledPackage = Packages.lookupInstalledPackage
--- packageName = Packages.packageName
--- lookupPackage = Packages.lookupPackage
--- getPackageConfigMap = Packages.getPackageConfigMap
-setThisInstalledUnitId :: InstalledUnitId -> DynFlags -> DynFlags
-setThisInstalledUnitId uid df = df { thisInstalledUnitId = uid}
-
-lookupUnit' :: Bool -> PackageConfigMap -> p -> UnitId -> Maybe PackageConfig
-lookupUnit' b pcm _ = Packages.lookupPackage' b pcm
-preloadClosureUs = const ()
-
-oldUnhelpfulSpan = UnhelpfulSpan
-pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan
-pattern OldRealSrcSpan x = RealSrcSpan x
-{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-}
-
-pattern NotBoot, IsBoot :: IsBootInterface
-pattern NotBoot = False
-pattern IsBoot = True
-
-initUnits = fmap fst . Packages.initPackages
-
-unitDepends = depends
-
-oldListVisibleModuleNames = Packages.listVisibleModuleNames
-oldLookupModuleWithSuggestions = Packages.lookupModuleWithSuggestions
--- oldLookupInPackageDB = Packages.lookupInPackageDB
-
-oldRenderWithStyle = Out.renderWithStyle
-oldMkUserStyle = Out.mkUserStyle
-oldMkErrStyle = Out.mkErrStyle
-oldFormatErrDoc = Err.formatErrDoc
-
--- Linear Haskell
-type Scaled a = a
-scaledThing :: Scaled a -> a
-scaledThing = id
-#endif
-
-getPackageName :: DynFlags -> InstalledUnitId -> Maybe PackageName
-getPackageName dfs i = packageName <$> lookupPackage dfs (definiteUnitId (defUnitId i))
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors df =
@@ -499,40 +220,6 @@ disableWarningsAsErrors df =
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal dfs f
= dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
-
-getRealSrcSpan :: RealLocated a -> RealSrcSpan
-getRealSrcSpan = GHC.getLoc
-#endif
-
-applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> ApiAnns -> ParsedSource -> IO ParsedSource
-applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do
- -- Apply parsedResultAction of plugins
- let applyPluginAction p opts = parsedResultAction p opts ms
- fmap hpm_module $
- runHsc env $ withPlugins dflags applyPluginAction
- (HsParsedModule parsed [] hpm_annotations)
-
-pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag
--- https://github.com/facebook/fbghc
-#ifdef __FACEBOOK_HASKELL__
-pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
-#else
-pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr
-#endif
-
--- | Take AST representation of type signature and drop `forall` part from it (if any), returning just type's body
-dropForAll :: LHsType pass -> LHsType pass
-#if MIN_VERSION_ghc(8,10,0)
-dropForAll = snd . GHC.splitLHsForAllTyInvis
-#else
-dropForAll = snd . GHC.splitLHsForAllTy
-#endif
-
-pattern FunTy :: Type -> Type -> Type
-#if MIN_VERSION_ghc(8,10,0)
-pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res}
-#else
-pattern FunTy arg res <- TyCoRep.FunTy arg res
#endif
isQualifiedImport :: ImportDecl a -> Bool
@@ -547,19 +234,21 @@ isQualifiedImport _ = False
#if MIN_VERSION_ghc(9,0,0)
-getNodeIds :: HieAST a -> M.Map Identifier (IdentifierDetails a)
-getNodeIds = M.foldl' combineNodeIds M.empty . getSourcedNodeInfo . sourcedNodeInfo
+getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
+getNodeIds = Map.foldl' combineNodeIds Map.empty . getSourcedNodeInfo . sourcedNodeInfo
-ad `combineNodeIds` (NodeInfo _ _ bd) = M.unionWith (<>) ad bd
+combineNodeIds :: Map.Map Identifier (IdentifierDetails a)
+ -> NodeInfo a -> Map.Map Identifier (IdentifierDetails a)
+ad `combineNodeIds` (NodeInfo _ _ bd) = Map.unionWith (<>) ad bd
-- Copied from GHC and adjusted to accept TypeIndex instead of Type
-- nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
-nodeInfo' = M.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo
+nodeInfo' = Map.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo
combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo as ai ad) `combineNodeInfo'` (NodeInfo bs bi bd) =
- NodeInfo (S.union as bs) (mergeSorted ai bi) (M.unionWith (<>) ad bd)
+ NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd)
where
mergeSorted :: Ord a => [a] -> [a] -> [a]
mergeSorted la@(a:as) lb@(b:bs) = case compare a b of
@@ -569,10 +258,9 @@ combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
mergeSorted as [] = as
mergeSorted [] bs = bs
-stringToUnit = Module.stringToUnit
-rtsUnit = Module.rtsUnit
#else
+getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds = nodeIdentifiers . nodeInfo
-- import qualified FastString as FS
@@ -580,15 +268,10 @@ getNodeIds = nodeIdentifiers . nodeInfo
nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' = nodeInfo
-- type Unit = UnitId
-unitString :: Unit -> String
-unitString = Module.unitIdString
-stringToUnit :: String -> Unit
-stringToUnit = Module.stringToUnitId
-- moduleUnit :: Module -> Unit
-- moduleUnit = moduleUnitId
-- unhelpfulSpanFS :: FS.FastString -> FS.FastString
-- unhelpfulSpanFS = id
-rtsUnit = Module.rtsUnitId
#endif
data GhcVersion
@@ -596,13 +279,16 @@ data GhcVersion
| GHC88
| GHC810
| GHC90
+ | GHC92
deriving (Eq, Ord, Show)
ghcVersionStr :: String
ghcVersionStr = VERSION_ghc
ghcVersion :: GhcVersion
-#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
+#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
+ghcVersion = GHC92
+#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
ghcVersion = GHC90
#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)
ghcVersion = GHC810
@@ -611,3 +297,19 @@ ghcVersion = GHC88
#elif MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
ghcVersion = GHC86
#endif
+
+runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
+runUnlit =
+#if MIN_VERSION_ghc(9,2,0)
+ SysTools.runUnlit
+#else
+ const SysTools.runUnlit
+#endif
+
+runPp :: Logger -> DynFlags -> [Option] -> IO ()
+runPp =
+#if MIN_VERSION_ghc(9,2,0)
+ SysTools.runPp
+#else
+ const SysTools.runPp
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs
new file mode 100644
index 0000000000000000000000000000000000000000..855e66e5ffe51ae74fe1b5d00555ba80f61d9d15
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs
@@ -0,0 +1,204 @@
+-- Copyright (c) 2019 The DAML Authors. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+-- Copied from https://github.com/ghc/ghc/blob/master/compiler/main/DriverPipeline.hs on 14 May 2019
+-- Requested to be exposed at https://gitlab.haskell.org/ghc/ghc/merge_requests/944.
+-- Update the above MR got merged to master on 31 May 2019. When it becomes avialable to ghc-lib, this file can be removed.
+
+{- HLINT ignore -} -- since copied from upstream
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+-- | Re-export 'doCpp' for GHC < 8.10.
+--
+-- Later versions export what we need.
+module Development.IDE.GHC.Compat.CPP (
+ doCpp
+ ) where
+
+import FileCleanup
+import Packages
+import Panic
+import SysTools
+#if MIN_VERSION_ghc(8,8,2)
+import LlvmCodeGen (llvmVersionList)
+#elif MIN_VERSION_ghc(8,8,0)
+import LlvmCodeGen (LlvmVersion (..))
+#endif
+import DynFlags
+import Module (toInstalledUnitId, rtsUnitId)
+import Control.Monad
+import Data.List (intercalate)
+import Data.Maybe
+import Data.Version
+import System.Directory
+import System.FilePath
+import System.Info
+
+import Development.IDE.GHC.Compat as Compat
+
+doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
+doCpp dflags raw input_fn output_fn = do
+ let hscpp_opts = picPOpts dflags
+ let cmdline_include_paths = includePaths dflags
+
+ pkg_include_dirs <- getPackageIncludePath dflags []
+ let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
+ (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
+ let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
+ (includePathsQuote cmdline_include_paths)
+ let include_paths = include_paths_quote ++ include_paths_global
+
+ let verbFlags = getVerbFlags dflags
+
+ let cpp_prog args | raw = SysTools.runCpp dflags args
+#if MIN_VERSION_ghc(8,10,0)
+ | otherwise = SysTools.runCc Nothing
+#else
+ | otherwise = SysTools.runCc
+#endif
+ dflags (SysTools.Option "-E" : args)
+
+ let target_defs =
+ -- NEIL: Patched to use System.Info instead of constants from CPP
+ [ "-D" ++ os ++ "_BUILD_OS",
+ "-D" ++ arch ++ "_BUILD_ARCH",
+ "-D" ++ os ++ "_HOST_OS",
+ "-D" ++ arch ++ "_HOST_ARCH" ]
+ -- remember, in code we *compile*, the HOST is the same our TARGET,
+ -- and BUILD is the same as our HOST.
+
+ let sse_defs =
+ [ "-D__SSE__" | isSseEnabled dflags ] ++
+ [ "-D__SSE2__" | isSse2Enabled dflags ] ++
+ [ "-D__SSE4_2__" | isSse4_2Enabled dflags ]
+
+ let avx_defs =
+ [ "-D__AVX__" | isAvxEnabled dflags ] ++
+ [ "-D__AVX2__" | isAvx2Enabled dflags ] ++
+ [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++
+ [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++
+ [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++
+ [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]
+
+ backend_defs <- getBackendDefs dflags
+
+ let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
+ -- Default CPP defines in Haskell source
+ ghcVersionH <- getGhcVersionPathName dflags
+ let hsSourceCppOpts = [ "-include", ghcVersionH ]
+
+ -- MIN_VERSION macros
+ let uids = explicitPackages (pkgState dflags)
+ pkgs = catMaybes (map (lookupPackage dflags) uids)
+ mb_macro_include <-
+ if not (null pkgs) && gopt Opt_VersionMacros dflags
+ then do macro_stub <- newTempName dflags TFL_CurrentModule "h"
+ writeFile macro_stub (generatePackageVersionMacros pkgs)
+ -- Include version macros for every *exposed* package.
+ -- Without -hide-all-packages and with a package database
+ -- size of 1000 packages, it takes cpp an estimated 2
+ -- milliseconds to process this file. See #10970
+ -- comment 8.
+ return [SysTools.FileOption "-include" macro_stub]
+ else return []
+
+ cpp_prog ( map SysTools.Option verbFlags
+ ++ map SysTools.Option include_paths
+ ++ map SysTools.Option hsSourceCppOpts
+ ++ map SysTools.Option target_defs
+ ++ map SysTools.Option backend_defs
+ ++ map SysTools.Option th_defs
+ ++ map SysTools.Option hscpp_opts
+ ++ map SysTools.Option sse_defs
+ ++ map SysTools.Option avx_defs
+ ++ mb_macro_include
+ -- Set the language mode to assembler-with-cpp when preprocessing. This
+ -- alleviates some of the C99 macro rules relating to whitespace and the hash
+ -- operator, which we tend to abuse. Clang in particular is not very happy
+ -- about this.
+ ++ [ SysTools.Option "-x"
+ , SysTools.Option "assembler-with-cpp"
+ , SysTools.Option input_fn
+ -- We hackily use Option instead of FileOption here, so that the file
+ -- name is not back-slashed on Windows. cpp is capable of
+ -- dealing with / in filenames, so it works fine. Furthermore
+ -- if we put in backslashes, cpp outputs #line directives
+ -- with *double* backslashes. And that in turn means that
+ -- our error messages get double backslashes in them.
+ -- In due course we should arrange that the lexer deals
+ -- with these \\ escapes properly.
+ , SysTools.Option "-o"
+ , SysTools.FileOption "" output_fn
+ ])
+
+getBackendDefs :: DynFlags -> IO [String]
+getBackendDefs dflags | hscTarget dflags == HscLlvm = do
+ llvmVer <- figureLlvmVersion dflags
+ return $ case llvmVer of
+#if MIN_VERSION_ghc(8,8,2)
+ Just v
+ | [m] <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, 0) ]
+ | m:n:_ <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, n) ]
+#elif MIN_VERSION_ghc(8,8,0)
+ Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ]
+ Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]
+#else
+ Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ]
+#endif
+ _ -> []
+ where
+ format (major, minor)
+ | minor >= 100 = error "getBackendDefs: Unsupported minor version"
+ | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int
+
+getBackendDefs _ =
+ return []
+
+-- ---------------------------------------------------------------------------
+-- Macros (cribbed from Cabal)
+
+generatePackageVersionMacros :: [Compat.UnitInfo] -> String
+generatePackageVersionMacros pkgs = concat
+ -- Do not add any C-style comments. See #3389.
+ [ generateMacros "" pkgname version
+ | pkg <- pkgs
+ , let version = packageVersion pkg
+ pkgname = map fixchar (packageNameString pkg)
+ ]
+
+fixchar :: Char -> Char
+fixchar '-' = '_'
+fixchar c = c
+
+generateMacros :: String -> String -> Version -> String
+generateMacros prefix name version =
+ concat
+ ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n"
+ ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
+ ," (major1) < ",major1," || \\\n"
+ ," (major1) == ",major1," && (major2) < ",major2," || \\\n"
+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
+ ,"\n\n"
+ ]
+ where
+ (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
+
+
+-- | Find out path to @ghcversion.h@ file
+getGhcVersionPathName :: DynFlags -> IO FilePath
+getGhcVersionPathName dflags = do
+ candidates <- case ghcVersionFile dflags of
+ Just path -> return [path]
+ Nothing -> (map (</> "ghcversion.h")) <$>
+ (getPackageIncludePath dflags [toInstalledUnitId rtsUnit])
+
+ found <- filterM doesFileExist candidates
+ case found of
+ [] -> throwGhcExceptionIO (InstallationError
+ ("ghcversion.h missing; tried: "
+ ++ intercalate ", " candidates))
+ (x:_) -> return x
+
+rtsUnit :: UnitId
+rtsUnit = Module.rtsUnitId
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b2f560e9c3c1da6fdf36f1e2b380fdd656d829e8
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs
@@ -0,0 +1,848 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
+-- TODO: remove
+{-# OPTIONS -Wno-dodgy-imports -Wno-unused-imports #-}
+
+-- | Compat Core module that handles the GHC module hierarchy re-organisation
+-- by re-exporting everything we care about.
+--
+-- This module provides no other compat mechanisms, except for simple
+-- backward-compatible pattern synonyms.
+module Development.IDE.GHC.Compat.Core (
+ -- * Session
+ DynFlags,
+ extensions,
+ extensionFlags,
+ targetPlatform,
+ packageFlags,
+ generalFlags,
+ warningFlags,
+ topDir,
+ hiDir,
+ tmpDir,
+ importPaths,
+ useColor,
+ canUseColor,
+ useUnicode,
+ objectDir,
+ flagsForCompletion,
+ setImportPaths,
+ outputFile,
+ pluginModNames,
+ refLevelHoleFits,
+ maxRefHoleFits,
+ maxValidHoleFits,
+#if MIN_VERSION_ghc(8,8,0)
+ CommandLineOption,
+#if !MIN_VERSION_ghc(9,2,0)
+ staticPlugins,
+#endif
+#endif
+ sPgm_F,
+ settings,
+ gopt,
+ gopt_set,
+ gopt_unset,
+ wopt,
+ wopt_set,
+ xFlags,
+ xopt,
+ xopt_unset,
+ xopt_set,
+ FlagSpec(..),
+ WarningFlag(..),
+ GeneralFlag(..),
+ PackageFlag,
+ PackageArg(..),
+ ModRenaming(..),
+ pattern ExposePackage,
+ parseDynamicFlagsCmdLine,
+ parseDynamicFilePragma,
+ WarnReason(..),
+ wWarningFlags,
+ updOptLevel,
+ -- slightly unsafe
+ setUnsafeGlobalDynFlags,
+ -- * Linear Haskell
+ Scaled,
+ scaledThing,
+ -- * Interface Files
+ IfaceExport,
+ IfaceTyCon(..),
+#if MIN_VERSION_ghc(8,10,0)
+ ModIface,
+ ModIface_(..),
+#else
+ ModIface(..),
+#endif
+ HscSource(..),
+ WhereFrom(..),
+ loadInterface,
+ SourceModified(..),
+ loadModuleInterface,
+ RecompileRequired(..),
+#if MIN_VERSION_ghc(8,10,0)
+ mkPartialIface,
+ mkFullIface,
+#else
+ mkIface,
+#endif
+ checkOldIface,
+#if MIN_VERSION_ghc(9,0,0)
+ IsBootInterface(..),
+#else
+ pattern IsBoot,
+ pattern NotBoot,
+#endif
+ -- * Fixity
+ LexicalFixity(..),
+ -- * ModSummary
+ ModSummary(..),
+ -- * HomeModInfo
+ HomeModInfo(..),
+ -- * ModGuts
+ ModGuts(..),
+ CgGuts(..),
+ -- * ModDetails
+ ModDetails(..),
+ -- * Var
+ Type (
+ TyCoRep.TyVarTy,
+ TyCoRep.AppTy,
+ TyCoRep.TyConApp,
+ TyCoRep.ForAllTy,
+ -- Omitted on purpose
+ -- pattern Synonym right below it
+ -- TyCoRep.FunTy,
+ TyCoRep.LitTy,
+ TyCoRep.CastTy,
+ TyCoRep.CoercionTy
+ ),
+ pattern FunTy,
+ Development.IDE.GHC.Compat.Core.splitForAllTyCoVars,
+ Development.IDE.GHC.Compat.Core.mkVisFunTys,
+ Development.IDE.GHC.Compat.Core.mkInfForAllTys,
+ -- * Specs
+ ImpDeclSpec(..),
+ ImportSpec(..),
+ -- * SourceText
+ SourceText(..),
+ -- * Name
+ tyThingParent_maybe,
+ -- * Ways
+ Way,
+ wayGeneralFlags,
+ wayUnsetGeneralFlags,
+ -- * AvailInfo
+ Avail.AvailInfo,
+ pattern AvailName,
+ pattern AvailFL,
+ pattern AvailTC,
+ Avail.availName,
+ Avail.availNames,
+ Avail.availNamesWithSelectors,
+ Avail.availsToNameSet,
+ -- * TcGblEnv
+ TcGblEnv(..),
+ -- * Parsing and LExer types
+ HsParsedModule(..),
+ GHC.ParsedModule(..),
+ GHC.ParsedSource,
+ GHC.RenamedSource,
+ -- * Compilation Main
+ HscEnv,
+ GHC.runGhc,
+ unGhc,
+ Session(..),
+ modifySession,
+ getSession,
+ GHC.setSessionDynFlags,
+ getSessionDynFlags,
+ GhcMonad,
+ Ghc,
+ runHsc,
+ compileFile,
+ Phase(..),
+ hscDesugar,
+ hscGenHardCode,
+ hscInteractive,
+ hscSimplify,
+ hscTypecheckRename,
+ makeSimpleDetails,
+ -- * Typecheck utils
+ Development.IDE.GHC.Compat.Core.tcSplitForAllTyVars,
+ Development.IDE.GHC.Compat.Core.tcSplitForAllTyVarBinder_maybe,
+ typecheckIface,
+ mkIfaceTc,
+ ImportedModsVal(..),
+ importedByUser,
+ GHC.TypecheckedSource,
+ -- * Source Locations
+ HasSrcSpan,
+ SrcLoc.Located,
+ SrcLoc.unLoc,
+ getLoc,
+ SrcLoc.RealLocated,
+ SrcLoc.GenLocated(..),
+ SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan),
+ SrcLoc.RealSrcSpan,
+ pattern RealSrcSpan,
+ SrcLoc.RealSrcLoc,
+ SrcLoc.SrcLoc(..),
+ BufSpan,
+ SrcLoc.leftmost_smallest,
+ SrcLoc.containsSpan,
+ SrcLoc.mkGeneralSrcSpan,
+ SrcLoc.mkRealSrcSpan,
+ SrcLoc.mkRealSrcLoc,
+ getRealSrcSpan,
+ SrcLoc.realSrcLocSpan,
+ SrcLoc.realSrcSpanStart,
+ SrcLoc.realSrcSpanEnd,
+ SrcLoc.isSubspanOf,
+ SrcLoc.wiredInSrcSpan,
+ SrcLoc.mkSrcSpan,
+ SrcLoc.srcSpanStart,
+ SrcLoc.srcSpanStartLine,
+ SrcLoc.srcSpanStartCol,
+ SrcLoc.srcSpanEnd,
+ SrcLoc.srcSpanEndLine,
+ SrcLoc.srcSpanEndCol,
+ SrcLoc.srcSpanFile,
+ SrcLoc.srcLocCol,
+ SrcLoc.srcLocFile,
+ SrcLoc.srcLocLine,
+ SrcLoc.noSrcSpan,
+ SrcLoc.noSrcLoc,
+ SrcLoc.noLoc,
+#if !MIN_VERSION_ghc(8,10,0) && MIN_VERSION_ghc(8,8,0)
+ SrcLoc.dL,
+#endif
+ -- * Finder
+ FindResult(..),
+ mkHomeModLocation,
+ addBootSuffixLocnOut,
+ findObjectLinkableMaybe,
+ InstalledFindResult(..),
+ -- * Module and Package
+ ModuleOrigin(..),
+ PackageName(..),
+ -- * Linker
+ Unlinked(..),
+ Linkable(..),
+ unload,
+ initDynLinker,
+ -- * Hooks
+ Hooks,
+ runMetaHook,
+ MetaHook,
+ MetaRequest(..),
+ metaRequestE,
+ metaRequestP,
+ metaRequestT,
+ metaRequestD,
+ metaRequestAW,
+ -- * HPT
+ addToHpt,
+ addListToHpt,
+ -- * Driver-Make
+ Target(..),
+ TargetId(..),
+ mkModuleGraph,
+ -- * GHCi
+ initObjLinker,
+ loadDLL,
+ InteractiveImport(..),
+ GHC.getContext,
+ GHC.setContext,
+ GHC.parseImportDecl,
+ GHC.runDecls,
+ Warn(..),
+ -- * ModLocation
+ GHC.ModLocation,
+ pattern ModLocation,
+ Module.ml_hs_file,
+ Module.ml_obj_file,
+ Module.ml_hi_file,
+ Development.IDE.GHC.Compat.Core.ml_hie_file,
+ -- * DataCon
+ Development.IDE.GHC.Compat.Core.dataConExTyCoVars,
+ -- * Role
+ Role(..),
+ -- * Panic
+ PlainGhcException,
+ panic,
+ -- * Util Module re-exports
+#if MIN_VERSION_ghc(9,0,0)
+ module GHC.Builtin.Names,
+ module GHC.Builtin.Types,
+ module GHC.Builtin.Types.Prim,
+ module GHC.Builtin.Utils,
+ module GHC.Core.Class,
+ module GHC.Core.Coercion,
+ module GHC.Core.ConLike,
+ module GHC.Core.DataCon,
+ module GHC.Core.FamInstEnv,
+ module GHC.Core.InstEnv,
+#if !MIN_VERSION_ghc(9,2,0)
+ module GHC.Core.Ppr.TyThing,
+#endif
+ module GHC.Core.PatSyn,
+ module GHC.Core.Predicate,
+ module GHC.Core.TyCon,
+ module GHC.Core.TyCo.Ppr,
+ module GHC.Core.Type,
+ module GHC.Core.Unify,
+ module GHC.Core.Utils,
+
+ module GHC.HsToCore.Docs,
+ module GHC.HsToCore.Expr,
+ module GHC.HsToCore.Monad,
+
+ module GHC.Iface.Tidy,
+ module GHC.Iface.Syntax,
+
+#if MIN_VERSION_ghc(9,2,0)
+ module Language.Haskell.Syntax.Expr,
+#endif
+
+ module GHC.Rename.Names,
+ module GHC.Rename.Splice,
+
+ module GHC.Tc.Instance.Family,
+ module GHC.Tc.Module,
+ module GHC.Tc.Types,
+ module GHC.Tc.Types.Evidence,
+ module GHC.Tc.Utils.Env,
+ module GHC.Tc.Utils.Monad,
+
+ module GHC.Types.Basic,
+ module GHC.Types.Id,
+ module GHC.Types.Name ,
+ module GHC.Types.Name.Set,
+
+ module GHC.Types.Name.Cache,
+ module GHC.Types.Name.Env,
+ module GHC.Types.Name.Reader,
+#if MIN_VERSION_ghc(9,2,0)
+ module GHC.Types.SourceFile,
+ module GHC.Types.SourceText,
+ module GHC.Types.TyThing,
+ module GHC.Types.TyThing.Ppr,
+#endif
+ module GHC.Types.Unique.Supply,
+ module GHC.Types.Var,
+ module GHC.Unit.Module,
+ module GHC.Utils.Error,
+#else
+ module BasicTypes,
+ module Class,
+#if MIN_VERSION_ghc(8,10,0)
+ module Coercion,
+ module Predicate,
+#endif
+ module ConLike,
+ module CoreUtils,
+ module DataCon,
+ module DsExpr,
+ module DsMonad,
+ module ErrUtils,
+ module FamInst,
+ module FamInstEnv,
+ module HeaderInfo,
+ module Id,
+ module InstEnv,
+ module IfaceSyn,
+ module Module,
+ module Name,
+ module NameCache,
+ module NameEnv,
+ module NameSet,
+ module PatSyn,
+ module PprTyThing,
+ module PrelInfo,
+ module PrelNames,
+ module RdrName,
+ module RnSplice,
+ module RnNames,
+ module TcEnv,
+ module TcEvidence,
+ module TcType,
+ module TcRnTypes,
+ module TcRnDriver,
+ module TcRnMonad,
+ module TidyPgm,
+ module TyCon,
+ module TysPrim,
+ module TysWiredIn,
+ module Type,
+ module Unify,
+ module UniqSupply,
+ module Var,
+#endif
+ -- * Syntax re-exports
+#if MIN_VERSION_ghc(9,0,0)
+ module GHC.Hs,
+ module GHC.Parser,
+ module GHC.Parser.Header,
+ module GHC.Parser.Lexer,
+#else
+#if MIN_VERSION_ghc(8,10,0)
+ module GHC.Hs,
+#else
+ module HsBinds,
+ module HsDecls,
+ module HsDoc,
+ module HsExtension,
+ noExtField,
+ module HsExpr,
+ module HsImpExp,
+ module HsLit,
+ module HsPat,
+ module HsSyn,
+ module HsTypes,
+ module HsUtils,
+#endif
+ module ExtractDocs,
+ module Parser,
+ module Lexer,
+#endif
+ ) where
+
+import qualified GHC
+
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Builtin.Names hiding (Unique, printName)
+import GHC.Builtin.Types
+import GHC.Builtin.Types.Prim
+import GHC.Builtin.Utils
+import GHC.Core.Class
+import GHC.Core.Coercion
+import GHC.Core.ConLike
+import GHC.Core.DataCon hiding (dataConExTyCoVars)
+import qualified GHC.Core.DataCon as DataCon
+import GHC.Core.FamInstEnv
+import GHC.Core.InstEnv
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Core.Multiplicity (scaledThing)
+#else
+import GHC.Core.Ppr.TyThing hiding (pprFamInst)
+import GHC.Core.TyCo.Rep (scaledThing)
+#endif
+import GHC.Core.PatSyn
+import GHC.Core.Predicate
+import GHC.Core.TyCo.Ppr
+import qualified GHC.Core.TyCo.Rep as TyCoRep
+import GHC.Core.TyCon
+import GHC.Core.Type hiding (mkInfForAllTys, mkVisFunTys)
+import GHC.Core.Unify
+import GHC.Core.Utils
+
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Driver.Env
+#else
+import GHC.Driver.Finder
+import GHC.Driver.Types
+import GHC.Driver.Ways
+#endif
+import GHC.Driver.CmdLine (Warn (..))
+import GHC.Driver.Hooks
+import GHC.Driver.Main
+import GHC.Driver.Monad
+import GHC.Driver.Phases
+import GHC.Driver.Pipeline
+import GHC.Driver.Plugins
+import GHC.Driver.Session hiding (ExposePackage)
+import qualified GHC.Driver.Session as DynFlags
+#if !MIN_VERSION_ghc(9,2,0)
+import GHC.Hs
+#endif
+import GHC.HsToCore.Docs
+import GHC.HsToCore.Expr
+import GHC.HsToCore.Monad
+import GHC.Iface.Load
+import GHC.Iface.Make (mkFullIface, mkIfaceTc,
+ mkPartialIface)
+import GHC.Iface.Recomp
+import GHC.Iface.Syntax
+import GHC.Iface.Tidy
+import GHC.IfaceToCore
+import GHC.Parser
+import GHC.Parser.Header hiding (getImports)
+import GHC.Parser.Lexer
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Linker.Loader
+import GHC.Linker.Types
+import GHC.Platform.Ways
+#else
+import GHC.Runtime.Linker
+#endif
+import GHC.Rename.Names
+import GHC.Rename.Splice
+import GHC.Runtime.Interpreter
+import GHC.Tc.Instance.Family
+import GHC.Tc.Module
+import GHC.Tc.Types
+import GHC.Tc.Types.Evidence hiding ((<.>))
+import GHC.Tc.Utils.Env
+import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef,
+ MonadFix (..), MonadIO (..), allM,
+ anyM, concatMapM, mapMaybeM, (<$>))
+import GHC.Tc.Utils.TcType as TcType
+import qualified GHC.Types.Avail as Avail
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Types.Meta
+#endif
+import GHC.Types.Basic
+import GHC.Types.Id
+import GHC.Types.Name hiding (varName)
+import GHC.Types.Name.Cache
+import GHC.Types.Name.Env
+import GHC.Types.Name.Reader
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Types.Name.Set
+import GHC.Types.SourceFile (HscSource (..),
+ SourceModified (..))
+import GHC.Types.SourceText
+import GHC.Types.TyThing
+import GHC.Types.TyThing.Ppr
+#else
+import GHC.Types.Name.Set
+#endif
+import GHC.Types.SrcLoc (BufSpan, SrcSpan (UnhelpfulSpan))
+import qualified GHC.Types.SrcLoc as SrcLoc
+import GHC.Types.Unique.Supply
+import GHC.Types.Var (Var (varName), setTyVarUnique,
+ setVarUnique)
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Unit.Finder
+import GHC.Unit.Home.ModInfo
+#endif
+import GHC.Unit.Info (PackageName (..))
+import GHC.Unit.Module hiding (ModLocation (..), UnitId,
+ addBootSuffixLocnOut, moduleUnit,
+ toUnitId)
+import qualified GHC.Unit.Module as Module
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Unit.Module.Imported
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module.ModGuts
+import GHC.Unit.Module.ModIface (IfaceExport)
+#endif
+import GHC.Unit.State (ModuleOrigin (..))
+import GHC.Utils.Error (Severity (..))
+import GHC.Utils.Panic hiding (try)
+import qualified GHC.Utils.Panic.Plain as Plain
+#else
+import qualified Avail
+import BasicTypes hiding (Version)
+import Class
+import CmdLineParser (Warn (..))
+import ConLike
+import CoreUtils
+import DataCon hiding (dataConExTyCoVars)
+import qualified DataCon
+import DriverPhases
+import DriverPipeline
+import DsExpr
+import DsMonad hiding (foldrM)
+import DynFlags hiding (ExposePackage)
+import qualified DynFlags
+import ErrUtils hiding (logInfo, mkWarnMsg)
+import ExtractDocs
+import FamInst
+import FamInstEnv
+import Finder
+#if MIN_VERSION_ghc(8,10,0)
+import GHC.Hs
+#endif
+import GHCi
+import GhcMonad
+import HeaderInfo hiding (getImports)
+import Hooks
+import HscMain
+import HscTypes
+#if !MIN_VERSION_ghc(8,10,0)
+-- Syntax imports
+import HsBinds
+import HsDecls
+import HsDoc
+import HsExpr
+import HsExtension
+import HsImpExp
+import HsLit
+import HsPat
+import HsSyn hiding (wildCardName)
+import HsTypes hiding (wildCardName)
+import HsUtils
+#endif
+import Id
+import IfaceSyn
+import InstEnv
+import Lexer hiding (getSrcLoc)
+import Linker
+import LoadIface
+import MkIface
+import Module hiding (ModLocation (..), UnitId,
+ addBootSuffixLocnOut, moduleUnitId)
+import qualified Module
+import Name hiding (varName)
+import NameCache
+import NameEnv
+import NameSet
+import Packages
+#if MIN_VERSION_ghc(8,8,0)
+import Panic hiding (try)
+import qualified PlainPanic as Plain
+#else
+import Panic hiding (GhcException, try)
+import qualified Panic as Plain
+#endif
+import Parser
+import PatSyn
+#if MIN_VERSION_ghc(8,8,0)
+import Plugins
+#endif
+import PprTyThing hiding (pprFamInst)
+import PrelInfo
+import PrelNames hiding (Unique, printName)
+import RdrName
+import RnNames
+import RnSplice
+import qualified SrcLoc
+import TcEnv
+import TcEvidence hiding ((<.>))
+import TcIface
+import TcRnDriver
+import TcRnMonad hiding (Applicative (..), IORef,
+ MonadFix (..), MonadIO (..), allM,
+ anyM, concatMapM, foldrM,
+ mapMaybeM, (<$>))
+import TcRnTypes
+import TcType hiding (mkVisFunTys)
+import qualified TcType
+import TidyPgm
+import qualified TyCoRep
+import TyCon
+import Type hiding (mkVisFunTys)
+import TysPrim
+import TysWiredIn
+import Unify
+import UniqSupply
+import Var (Var (varName), setTyVarUnique,
+ setVarUnique, varType)
+
+#if MIN_VERSION_ghc(8,10,0)
+import Coercion (coercionKind)
+import Predicate
+import SrcLoc (SrcSpan (UnhelpfulSpan))
+#else
+import SrcLoc (RealLocated,
+ SrcSpan (UnhelpfulSpan))
+#endif
+#endif
+
+#if !MIN_VERSION_ghc(8,8,0)
+import Data.List (isSuffixOf)
+import System.FilePath
+#endif
+
+#if !MIN_VERSION_ghc(9,0,0)
+type BufSpan = ()
+#endif
+
+pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
+#if MIN_VERSION_ghc(9,0,0)
+pattern RealSrcSpan x y = SrcLoc.RealSrcSpan x y
+#else
+pattern RealSrcSpan x y <- ((,Nothing) -> (SrcLoc.RealSrcSpan x, y)) where
+ RealSrcSpan x _ = SrcLoc.RealSrcSpan x
+#endif
+{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
+
+
+pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
+#if __GLASGOW_HASKELL__ >= 902
+pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of
+ Avail.NormalGreName name -> (name: names, pieces)
+ Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces))
+#else
+pattern AvailTC n names pieces <- Avail.AvailTC n names pieces
+#endif
+
+pattern AvailName :: Name -> Avail.AvailInfo
+#if __GLASGOW_HASKELL__ >= 902
+pattern AvailName n <- Avail.Avail (Avail.NormalGreName n)
+#else
+pattern AvailName n <- Avail.Avail n
+#endif
+
+pattern AvailFL :: FieldLabel -> Avail.AvailInfo
+#if __GLASGOW_HASKELL__ >= 902
+pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl)
+#else
+-- pattern synonym that is never populated
+pattern AvailFL x <- Avail.Avail (const (True, undefined) -> (False, x))
+#endif
+
+{-# COMPLETE AvailTC, AvailName, AvailFL #-}
+
+setImportPaths :: [FilePath] -> DynFlags -> DynFlags
+setImportPaths importPaths flags = flags { importPaths = importPaths }
+
+pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag
+-- https://github.com/facebook/fbghc
+#ifdef __FACEBOOK_HASKELL__
+pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
+#else
+pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr
+#endif
+
+pattern FunTy :: Type -> Type -> Type
+#if MIN_VERSION_ghc(8,10,0)
+pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res}
+#else
+pattern FunTy arg res <- TyCoRep.FunTy arg res
+#endif
+
+#if MIN_VERSION_ghc(9,0,0)
+-- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x)
+-- type HasSrcSpan x = () :: Constraint
+
+class HasSrcSpan a where
+ getLoc :: a -> SrcSpan
+
+instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where
+ getLoc = GHC.getLoc
+
+-- getLoc :: GenLocated l a -> l
+-- getLoc = GHC.getLoc
+
+#elif MIN_VERSION_ghc(8,8,0)
+type HasSrcSpan = SrcLoc.HasSrcSpan
+getLoc :: SrcLoc.HasSrcSpan a => a -> SrcLoc.SrcSpan
+getLoc = SrcLoc.getLoc
+
+#else
+
+class HasSrcSpan a where
+ getLoc :: a -> SrcSpan
+instance HasSrcSpan Name where
+ getLoc = nameSrcSpan
+instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where
+ getLoc = SrcLoc.getLoc
+
+#endif
+
+getRealSrcSpan :: SrcLoc.RealLocated a -> SrcLoc.RealSrcSpan
+#if !MIN_VERSION_ghc(8,8,0)
+getRealSrcSpan = SrcLoc.getLoc
+#else
+getRealSrcSpan = SrcLoc.getRealSrcSpan
+#endif
+
+
+-- | Add the @-boot@ suffix to all output file paths associated with the
+-- module, not including the input file itself
+addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation
+#if !MIN_VERSION_ghc(8,8,0)
+addBootSuffixLocnOut locn
+ = locn { Module.ml_hi_file = Module.addBootSuffix (Module.ml_hi_file locn)
+ , Module.ml_obj_file = Module.addBootSuffix (Module.ml_obj_file locn)
+ }
+#else
+addBootSuffixLocnOut = Module.addBootSuffixLocnOut
+#endif
+
+
+dataConExTyCoVars :: DataCon -> [TyCoVar]
+#if __GLASGOW_HASKELL__ >= 808
+dataConExTyCoVars = DataCon.dataConExTyCoVars
+#else
+dataConExTyCoVars = DataCon.dataConExTyVars
+#endif
+
+#if !MIN_VERSION_ghc(9,0,0)
+-- Linear Haskell
+type Scaled a = a
+scaledThing :: Scaled a -> a
+scaledThing = id
+#endif
+
+mkVisFunTys :: [Scaled Type] -> Type -> Type
+mkVisFunTys =
+#if __GLASGOW_HASKELL__ <= 808
+ mkFunTys
+#else
+ TcType.mkVisFunTys
+#endif
+
+mkInfForAllTys :: [TyVar] -> Type -> Type
+mkInfForAllTys =
+#if MIN_VERSION_ghc(9,0,0)
+ TcType.mkInfForAllTys
+#else
+ mkInvForAllTys
+#endif
+
+splitForAllTyCoVars :: Type -> ([TyCoVar], Type)
+splitForAllTyCoVars =
+#if MIN_VERSION_ghc(9,2,0)
+ TcType.splitForAllTyCoVars
+#else
+ splitForAllTys
+#endif
+
+tcSplitForAllTyVars :: Type -> ([TyVar], Type)
+tcSplitForAllTyVars =
+#if MIN_VERSION_ghc(9,2,0)
+ TcType.tcSplitForAllTyVars
+#else
+ tcSplitForAllTys
+#endif
+
+
+tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type)
+tcSplitForAllTyVarBinder_maybe =
+#if MIN_VERSION_ghc(9,2,0)
+ TcType.tcSplitForAllTyVarBinder_maybe
+#else
+ tcSplitForAllTy_maybe
+#endif
+
+pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation
+#if MIN_VERSION_ghc(8,8,0)
+pattern ModLocation a b c <-
+ GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c ""
+#else
+pattern ModLocation a b c <-
+ GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c
+#endif
+
+#if !MIN_VERSION_ghc(8,10,0)
+noExtField :: GHC.NoExt
+noExtField = GHC.noExt
+#endif
+
+ml_hie_file :: GHC.ModLocation -> FilePath
+#if !MIN_VERSION_ghc(8,8,0)
+ml_hie_file ml
+ | "boot" `isSuffixOf ` Module.ml_hi_file ml = Module.ml_hi_file ml -<.> ".hie-boot"
+ | otherwise = Module.ml_hi_file ml -<.> ".hie"
+#else
+ml_hie_file = Module.ml_hie_file
+#endif
+
+#if !MIN_VERSION_ghc(9,0,0)
+pattern NotBoot, IsBoot :: IsBootInterface
+pattern NotBoot = False
+pattern IsBoot = True
+#endif
+
+#if MIN_VERSION_ghc(8,8,0)
+type PlainGhcException = Plain.PlainGhcException
+#else
+type PlainGhcException = Plain.GhcException
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2def0e41211d92b5bdba739b4b1c1aba3a355bad
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs
@@ -0,0 +1,284 @@
+{-# LANGUAGE CPP #-}
+
+-- | Compat module for the main Driver types, such as 'HscEnv',
+-- 'UnitEnv' and some DynFlags compat functions.
+module Development.IDE.GHC.Compat.Env (
+ Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph, hsc_HPT, hsc_type_env_var),
+ InteractiveContext(..),
+ setInteractivePrintName,
+ setInteractiveDynFlags,
+ Env.hsc_dflags,
+ hsc_EPS,
+ hsc_logger,
+ hsc_tmpfs,
+ hsc_unit_env,
+ hsc_hooks,
+ hscSetHooks,
+ TmpFs,
+ -- * HomeUnit
+ hscHomeUnit,
+ HomeUnit,
+ setHomeUnitId_,
+ Development.IDE.GHC.Compat.Env.mkHomeModule,
+ -- * Provide backwards Compatible
+ -- types and helper functions.
+ Logger(..),
+ UnitEnv,
+ hscSetUnitEnv,
+ hscSetFlags,
+ initTempFs,
+ -- * Home Unit
+ Development.IDE.GHC.Compat.Env.homeUnitId_,
+ -- * DynFlags Helper
+ setBytecodeLinkerOptions,
+ setInterpreterLinkerOptions,
+ -- * Ways
+ Ways,
+ Way,
+ hostFullWays,
+ setWays,
+ wayGeneralFlags,
+ wayUnsetGeneralFlags,
+ -- * Backend, backwards compatible
+ Backend,
+ setBackend,
+ Development.IDE.GHC.Compat.Env.platformDefaultBackend,
+ ) where
+
+import GHC (setInteractiveDynFlags)
+
+#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Driver.Backend as Backend
+import GHC.Driver.Env (HscEnv, hsc_EPS)
+import qualified GHC.Driver.Env as Env
+import qualified GHC.Driver.Session as Session
+import GHC.Platform.Ways hiding (hostFullWays)
+import qualified GHC.Platform.Ways as Ways
+import GHC.Runtime.Context
+import GHC.Unit.Env (UnitEnv)
+import GHC.Unit.Home as Home
+import GHC.Utils.Logger
+import GHC.Utils.TmpFs
+#else
+import qualified GHC.Driver.Session as DynFlags
+import GHC.Driver.Types (HscEnv, InteractiveContext (..), hsc_EPS,
+ setInteractivePrintName)
+import qualified GHC.Driver.Types as Env
+import GHC.Driver.Ways hiding (hostFullWays)
+import qualified GHC.Driver.Ways as Ways
+#endif
+import GHC.Driver.Hooks (Hooks)
+import GHC.Driver.Session hiding (mkHomeModule)
+import GHC.Unit.Module.Name
+import GHC.Unit.Types (Module, Unit, UnitId, mkModule)
+#else
+import DynFlags
+import Hooks
+import HscTypes as Env
+import Module
+#endif
+
+#if MIN_VERSION_ghc(9,0,0)
+import qualified Data.Set as Set
+#endif
+#if !MIN_VERSION_ghc(9,2,0)
+import Data.IORef
+#endif
+
+#if !MIN_VERSION_ghc(9,2,0)
+type UnitEnv = ()
+newtype Logger = Logger { log_action :: LogAction }
+type TmpFs = ()
+#endif
+
+setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags
+#if MIN_VERSION_ghc(9,2,0)
+setHomeUnitId_ uid df = df { Session.homeUnitId_ = uid }
+#elif MIN_VERSION_ghc(9,0,0)
+setHomeUnitId_ uid df = df { homeUnitId = uid }
+#else
+setHomeUnitId_ uid df = df { thisInstalledUnitId = toInstalledUnitId uid }
+#endif
+
+hscSetFlags :: DynFlags -> HscEnv -> HscEnv
+hscSetFlags df env =
+#if MIN_VERSION_ghc(9,2,0)
+ hscSetFlags df env
+#else
+ env { Env.hsc_dflags = df }
+#endif
+
+initTempFs :: HscEnv -> IO HscEnv
+initTempFs env = do
+#if MIN_VERSION_ghc(9,2,0)
+ tmpFs <- initTmpFs
+ pure env { Env.hsc_tmpfs = tmpFs }
+#else
+ filesToClean <- newIORef emptyFilesToClean
+ dirsToClean <- newIORef mempty
+ let dflags = (Env.hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True}
+ pure $ hscSetFlags dflags env
+#endif
+
+hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv
+#if MIN_VERSION_ghc(9,2,0)
+hscSetUnitEnv ue env = env { Env.hsc_unit_env = ue }
+#else
+hscSetUnitEnv _ env = env
+#endif
+
+hsc_unit_env :: HscEnv -> UnitEnv
+hsc_unit_env =
+#if MIN_VERSION_ghc(9,2,0)
+ Env.hsc_unit_env
+#else
+ const ()
+#endif
+
+hsc_tmpfs :: HscEnv -> TmpFs
+hsc_tmpfs =
+#if MIN_VERSION_ghc(9,2,0)
+ Env.hsc_tmpfs
+#else
+ const ()
+#endif
+
+hsc_logger :: HscEnv -> Logger
+hsc_logger =
+#if MIN_VERSION_ghc(9,2,0)
+ Env.hsc_logger
+#else
+ Logger . DynFlags.log_action . Env.hsc_dflags
+#endif
+
+hsc_hooks :: HscEnv -> Hooks
+hsc_hooks =
+#if MIN_VERSION_ghc(9,2,0)
+ Env.hsc_hooks
+#else
+ hooks . Env.hsc_dflags
+#endif
+
+hscSetHooks :: Hooks -> HscEnv -> HscEnv
+hscSetHooks hooks env =
+#if MIN_VERSION_ghc(9,2,0)
+ env { Env.hsc_hooks = hooks }
+#else
+ hscSetFlags ((Env.hsc_dflags env) { hooks = hooks}) env
+#endif
+
+homeUnitId_ :: DynFlags -> UnitId
+homeUnitId_ =
+#if MIN_VERSION_ghc(9,2,0)
+ Session.homeUnitId_
+#elif MIN_VERSION_ghc(9,0,0)
+ homeUnitId
+#else
+ thisPackage
+#endif
+
+
+#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
+type HomeUnit = Unit
+#elif !MIN_VERSION_ghc(9,0,0)
+type HomeUnit = UnitId
+#endif
+
+hscHomeUnit :: HscEnv -> HomeUnit
+hscHomeUnit =
+#if MIN_VERSION_ghc(9,2,0)
+ Env.hsc_home_unit
+#elif MIN_VERSION_ghc(9,0,0)
+ homeUnit . Env.hsc_dflags
+#else
+ homeUnitId_ . hsc_dflags
+#endif
+
+mkHomeModule :: HomeUnit -> ModuleName -> Module
+mkHomeModule =
+#if MIN_VERSION_ghc(9,2,0)
+ Home.mkHomeModule
+#else
+ mkModule
+#endif
+
+-- | We don't want to generate object code so we compile to bytecode
+-- (HscInterpreted) which implies LinkInMemory
+-- HscInterpreted
+setBytecodeLinkerOptions :: DynFlags -> DynFlags
+setBytecodeLinkerOptions df = df {
+ ghcLink = LinkInMemory
+#if MIN_VERSION_ghc(9,2,0)
+ , backend = NoBackend
+#else
+ , hscTarget = HscNothing
+#endif
+ , ghcMode = CompManager
+ }
+
+setInterpreterLinkerOptions :: DynFlags -> DynFlags
+setInterpreterLinkerOptions df = df {
+ ghcLink = LinkInMemory
+#if MIN_VERSION_ghc(9,2,0)
+ , backend = Interpreter
+#else
+ , hscTarget = HscInterpreted
+#endif
+ , ghcMode = CompManager
+ }
+
+-- -------------------------------------------------------
+-- Ways helpers
+-- -------------------------------------------------------
+
+#if !MIN_VERSION_ghc(9,2,0) && MIN_VERSION_ghc(9,0,0)
+type Ways = Set.Set Way
+#elif !MIN_VERSION_ghc(9,0,0)
+type Ways = [Way]
+#endif
+
+hostFullWays :: Ways
+hostFullWays =
+#if MIN_VERSION_ghc(9,0,0)
+ Ways.hostFullWays
+#else
+ interpWays
+#endif
+
+setWays :: Ways -> DynFlags -> DynFlags
+setWays ways flags =
+#if MIN_VERSION_ghc(9,2,0)
+ flags { Session.targetWays_ = ways}
+#elif MIN_VERSION_ghc(9,0,0)
+ flags {ways = ways}
+#else
+ updateWays $ flags {ways = ways}
+#endif
+
+-- -------------------------------------------------------
+-- Backend helpers
+-- -------------------------------------------------------
+
+#if !MIN_VERSION_ghc(9,2,0)
+type Backend = HscTarget
+#endif
+
+platformDefaultBackend :: DynFlags -> Backend
+platformDefaultBackend =
+#if MIN_VERSION_ghc(9,2,0)
+ Backend.platformDefaultBackend . targetPlatform
+#elif MIN_VERSION_ghc(8,10,0)
+ defaultObjectTarget
+#else
+ defaultObjectTarget . DynFlags.targetPlatform
+#endif
+
+setBackend :: Backend -> DynFlags -> DynFlags
+setBackend backend flags =
+#if MIN_VERSION_ghc(9,2,0)
+ flags { backend = backend }
+#else
+ flags { hscTarget = backend }
+#endif
+
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs
new file mode 100644
index 0000000000000000000000000000000000000000..36ac26a446eb5934ca653b20ede2f28e1033eabd
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE CPP #-}
+
+-- | Compat module Interface file relevant code.
+module Development.IDE.GHC.Compat.Iface (
+ writeIfaceFile,
+ cannotFindModule,
+ ) where
+
+import GHC
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Iface.Load as Iface
+import GHC.Unit.Finder.Types (FindResult)
+#elif MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Driver.Finder as Finder
+import GHC.Driver.Types (FindResult)
+import qualified GHC.Iface.Load as Iface
+#else
+import Finder (FindResult)
+import qualified Finder
+import qualified MkIface
+#endif
+
+import Development.IDE.GHC.Compat.Env
+import Development.IDE.GHC.Compat.Outputable
+
+writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO ()
+#if MIN_VERSION_ghc(9,2,0)
+writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface
+#elif MIN_VERSION_ghc(9,0,0)
+writeIfaceFile env = Iface.writeIface (hsc_dflags env)
+#else
+writeIfaceFile env = MkIface.writeIfaceFile (hsc_dflags env)
+#endif
+
+cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
+cannotFindModule env modname fr =
+#if MIN_VERSION_ghc(9,2,0)
+ Iface.cannotFindModule env modname fr
+#else
+ Finder.cannotFindModule (hsc_dflags env) modname fr
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs
new file mode 100644
index 0000000000000000000000000000000000000000..cb94532eb71333e1182d1033de040477b7cbee76
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE CPP #-}
+-- | Compat module for GHC 9.2 Logger infrastructure.
+module Development.IDE.GHC.Compat.Logger (
+ putLogHook,
+ Development.IDE.GHC.Compat.Logger.pushLogHook,
+ -- * Logging stuff
+ LogActionCompat,
+ logActionCompat,
+ defaultLogActionHPutStrDoc,
+ ) where
+
+import Development.IDE.GHC.Compat.Core
+import Development.IDE.GHC.Compat.Env as Env
+import Development.IDE.GHC.Compat.Outputable
+
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Driver.Session as DynFlags
+import GHC.Utils.Outputable
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Driver.Env (hsc_logger)
+import GHC.Utils.Logger as Logger
+#endif
+#else
+import DynFlags
+import Outputable (queryQual)
+#endif
+
+putLogHook :: Logger -> HscEnv -> HscEnv
+putLogHook logger env =
+#if MIN_VERSION_ghc(9,2,0)
+ env { hsc_logger = logger }
+#else
+ hscSetFlags ((hsc_dflags env) { DynFlags.log_action = Env.log_action logger }) env
+#endif
+
+pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger
+pushLogHook f logger =
+#if MIN_VERSION_ghc(9,2,0)
+ Logger.pushLogHook f logger
+#else
+ logger { Env.log_action = f (Env.log_action logger) }
+#endif
+
+#if MIN_VERSION_ghc(9,0,0)
+type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO ()
+
+-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test.
+logActionCompat :: LogActionCompat -> LogAction
+logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify
+
+#else
+type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO ()
+
+logActionCompat :: LogActionCompat -> LogAction
+logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (queryQual style)
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e3b6d2a453ec78dac437add9c31a0af1f7faa015
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE CPP #-}
+
+module Development.IDE.GHC.Compat.Outputable (
+ SDoc,
+ Outputable,
+ showSDoc,
+ showSDocUnsafe,
+ showSDocForUser,
+ ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest,
+ printSDocQualifiedUnsafe,
+ printNameWithoutUniques,
+ printSDocAllTheWay,
+ mkPrintUnqualified,
+ mkPrintUnqualifiedDefault,
+ PrintUnqualified(..),
+ -- * Parser errors
+ PsWarning,
+ PsError,
+ pprWarning,
+ pprError,
+ -- * Error infrastructure
+ DecoratedSDoc,
+ MsgEnvelope,
+ errMsgSpan,
+ errMsgSeverity,
+ formatErrorWithQual,
+ mkWarnMsg,
+ mkSrcErr,
+ srcErrorMessages,
+ ) where
+
+
+#if MIN_VERSION_ghc(9,2,0)
+import GHC.Driver.Ppr
+import GHC.Driver.Session
+import GHC.Parser.Errors
+import qualified GHC.Parser.Errors.Ppr as Ppr
+import qualified GHC.Types.Error as Error
+import GHC.Types.Name.Ppr
+import GHC.Types.SourceError
+import GHC.Types.SrcLoc
+import GHC.Unit.State
+import GHC.Utils.Error hiding (mkWarnMsg)
+import GHC.Utils.Logger
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+#elif MIN_VERSION_ghc(9,0,0)
+import GHC.Driver.Session
+import GHC.Driver.Types as HscTypes
+import GHC.Types.Name.Reader (GlobalRdrEnv)
+import GHC.Types.SrcLoc
+import GHC.Utils.Error as Err hiding (mkWarnMsg)
+import qualified GHC.Utils.Error as Err
+import GHC.Utils.Outputable as Out
+#else
+import Development.IDE.GHC.Compat.Core (GlobalRdrEnv)
+import DynFlags
+import ErrUtils hiding (mkWarnMsg)
+import qualified ErrUtils as Err
+import HscTypes
+import Outputable as Out
+import SrcLoc
+#endif
+
+printNameWithoutUniques :: Outputable a => a -> String
+printNameWithoutUniques =
+#if MIN_VERSION_ghc(9,2,0)
+ renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr
+#else
+ printSDocAllTheWay dyn . ppr
+ where
+ dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques
+#endif
+
+printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
+#if MIN_VERSION_ghc(9,2,0)
+printSDocQualifiedUnsafe unqual doc =
+ -- Taken from 'showSDocForUser'
+ renderWithContext (defaultSDocContext { sdocStyle = sty }) doc'
+ where
+ sty = mkUserStyle unqual AllTheWay
+ doc' = pprWithUnitState emptyUnitState doc
+#else
+printSDocQualifiedUnsafe unqual doc =
+ showSDocForUser unsafeGlobalDynFlags unqual doc
+#endif
+
+printSDocAllTheWay :: DynFlags -> SDoc -> String
+#if MIN_VERSION_ghc(9,2,0)
+printSDocAllTheWay dflags sdoc = renderWithContext ctxt sdoc
+ where
+ ctxt = initSDocContext dflags (mkUserStyle neverQualify AllTheWay)
+#else
+printSDocAllTheWay dflags sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags Out.neverQualify Out.AllTheWay)
+
+#if MIN_VERSION_ghc(9,0,0)
+oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc
+oldMkUserStyle _ = Out.mkUserStyle
+oldMkErrStyle _ = Out.mkErrStyle
+
+oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
+oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext
+ where dummySDocContext = initSDocContext dflags Out.defaultUserStyle
+
+#else
+oldRenderWithStyle :: DynFlags -> Out.SDoc -> Out.PprStyle -> String
+oldRenderWithStyle = Out.renderWithStyle
+
+oldMkUserStyle :: DynFlags -> Out.PrintUnqualified -> Out.Depth -> Out.PprStyle
+oldMkUserStyle = Out.mkUserStyle
+
+oldMkErrStyle :: DynFlags -> Out.PrintUnqualified -> Out.PprStyle
+oldMkErrStyle = Out.mkErrStyle
+
+oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
+oldFormatErrDoc = Err.formatErrDoc
+#endif
+#endif
+
+pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
+pprWarning =
+#if MIN_VERSION_ghc(9,2,0)
+ Ppr.pprWarning
+#else
+ id
+#endif
+
+pprError :: PsError -> MsgEnvelope DecoratedSDoc
+pprError =
+#if MIN_VERSION_ghc(9,2,0)
+ Ppr.pprError
+#else
+ id
+#endif
+
+formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String
+formatErrorWithQual dflags e =
+#if MIN_VERSION_ghc(9,2,0)
+ showSDoc dflags (pprLocMsgEnvelope e)
+#else
+ Out.showSDoc dflags
+ $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e)
+ $ oldFormatErrDoc dflags
+ $ Err.errMsgDoc e
+#endif
+
+#if !MIN_VERSION_ghc(9,2,0)
+type DecoratedSDoc = ()
+type MsgEnvelope e = ErrMsg
+
+type PsWarning = ErrMsg
+type PsError = ErrMsg
+#endif
+
+mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualifiedDefault =
+ HscTypes.mkPrintUnqualified unsafeGlobalDynFlags
+
+mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
+mkWarnMsg =
+#if MIN_VERSION_ghc(9,2,0)
+ const Error.mkWarnMsg
+#else
+ Err.mkWarnMsg
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs
new file mode 100644
index 0000000000000000000000000000000000000000..450b0cf5ecdb24c0be198a6e513f817e0147a007
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE CPP #-}
+
+-- | Parser compaibility module.
+module Development.IDE.GHC.Compat.Parser (
+ initParserOpts,
+ initParserState,
+#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
+ -- in GHC == 9.2 the type doesn't exist
+ -- In GHC == 9.0 it is a data-type
+ -- and GHC < 9.0 it is type-def
+ --
+ -- Export data-type here, otherwise only the simple type.
+ Anno.ApiAnns(..),
+#else
+ ApiAnns,
+#endif
+ mkHsParsedModule,
+ mkParsedModule,
+ mkApiAnns,
+ -- * API Annotations
+ Anno.AnnKeywordId(..),
+ Anno.AnnotationComment(..),
+ ) where
+
+#if MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Parser.Lexer as Lexer
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Driver.Config as Config
+import GHC.Parser.Lexer hiding (initParserState)
+#else
+import qualified GHC.Parser.Annotation as Anno
+#endif
+#else
+import qualified ApiAnnotation as Anno
+import Lexer
+import qualified SrcLoc
+#endif
+import Development.IDE.GHC.Compat.Core
+import Development.IDE.GHC.Compat.Util
+
+#if !MIN_VERSION_ghc(9,2,0)
+import qualified Data.Map as Map
+#endif
+
+#if !MIN_VERSION_ghc(9,0,0)
+type ParserOpts = DynFlags
+#elif !MIN_VERSION_ghc(9,2,0)
+type ParserOpts = Lexer.ParserFlags
+#endif
+
+initParserOpts :: DynFlags -> ParserOpts
+initParserOpts =
+#if MIN_VERSION_ghc(9,2,0)
+ Config.initParserOpts
+#elif MIN_VERSION_ghc(9,0,0)
+ Lexer.mkParserFlags
+#else
+ id
+#endif
+
+initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
+initParserState =
+#if MIN_VERSION_ghc(9,2,0)
+ Lexer.initParserState
+#elif MIN_VERSION_ghc(9,0,0)
+ Lexer.mkPStatePure
+#else
+ Lexer.mkPState
+#endif
+
+#if MIN_VERSION_ghc(9,2,0)
+type ApiAnns = ()
+#else
+type ApiAnns = Anno.ApiAnns
+#endif
+
+
+mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule
+mkHsParsedModule parsed fps hpm_annotations =
+ HsParsedModule
+ parsed
+ fps
+#if !MIN_VERSION_ghc(9,2,0)
+ hpm_annotations
+#endif
+
+
+mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule
+mkParsedModule ms parsed extra_src_files _hpm_annotations =
+ ParsedModule {
+ pm_mod_summary = ms
+ , pm_parsed_source = parsed
+ , pm_extra_src_files = extra_src_files
+#if !MIN_VERSION_ghc(9,2,0)
+ , pm_annotations = _hpm_annotations
+#endif
+ }
+
+mkApiAnns :: PState -> ApiAnns
+#if MIN_VERSION_ghc(9,2,0)
+mkApiAnns = const ()
+#else
+mkApiAnns pst =
+#if MIN_VERSION_ghc(9,0,1)
+ -- Copied from GHC.Driver.Main
+ Anno.ApiAnns {
+ apiAnnItems = Map.fromListWith (++) $ annotations pst,
+ apiAnnEofPos = eof_pos pst,
+ apiAnnComments = Map.fromList (annotations_comments pst),
+ apiAnnRogueComments = comment_q pst
+ }
+#else
+ (Map.fromListWith (++) $ annotations pst,
+ Map.fromList ((SrcLoc.noSrcSpan,comment_q pst)
+ :annotations_comments pst))
+#endif
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs
new file mode 100644
index 0000000000000000000000000000000000000000..6621b70e9c8496e08edeeb5d3dbfcb087c527682
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE CPP #-}
+
+-- | Plugin Compat utils.
+module Development.IDE.GHC.Compat.Plugins (
+ Plugin(..),
+ defaultPlugin,
+#if __GLASGOW_HASKELL__ >= 808
+ PluginWithArgs(..),
+#endif
+ applyPluginsParsedResultAction,
+ initializePlugins,
+
+ -- * Static plugins
+#if MIN_VERSION_ghc(8,8,0)
+ StaticPlugin(..),
+ hsc_static_plugins,
+#endif
+ ) where
+
+import GHC
+#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Driver.Env as Env
+#endif
+import GHC.Driver.Plugins (Plugin (..),
+ PluginWithArgs (..),
+ StaticPlugin (..),
+ defaultPlugin, withPlugins)
+import qualified GHC.Runtime.Loader as Loader
+#elif MIN_VERSION_ghc(8,8,0)
+import qualified DynamicLoading as Loader
+import Plugins
+#else
+import qualified DynamicLoading as Loader
+import Plugins (Plugin (..), defaultPlugin,
+ withPlugins)
+#endif
+import Development.IDE.GHC.Compat.Core
+import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags)
+import Development.IDE.GHC.Compat.Parser as Parser
+
+applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> IO ParsedSource
+applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do
+ -- Apply parsedResultAction of plugins
+ let applyPluginAction p opts = parsedResultAction p opts ms
+ fmap hpm_module $
+ runHsc env $ withPlugins
+#if MIN_VERSION_ghc(9,2,0)
+ env
+#else
+ dflags
+#endif
+ applyPluginAction
+ (mkHsParsedModule parsed [] hpm_annotations)
+
+initializePlugins :: HscEnv -> IO HscEnv
+initializePlugins env = do
+#if MIN_VERSION_ghc(9,2,0)
+ Loader.initializePlugins env
+#else
+ newDf <- Loader.initializePlugins env (hsc_dflags env)
+ pure $ hscSetFlags newDf env
+#endif
+
+
+#if MIN_VERSION_ghc(8,8,0)
+hsc_static_plugins :: HscEnv -> [StaticPlugin]
+#if MIN_VERSION_ghc(9,2,0)
+hsc_static_plugins = Env.hsc_static_plugins
+#else
+hsc_static_plugins = staticPlugins . hsc_dflags
+#endif
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9f6910055996a66749f46e1ab441cde17beb72ed
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs
@@ -0,0 +1,345 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- | Compat module for 'UnitState' and 'UnitInfo'.
+module Development.IDE.GHC.Compat.Units (
+ -- * UnitState
+ UnitState,
+ initUnits,
+ unitState,
+ getUnitName,
+ explicitUnits,
+ preloadClosureUs,
+ listVisibleModuleNames,
+ LookupResult(..),
+ lookupModuleWithSuggestions,
+ -- * UnitInfoMap
+ UnitInfoMap,
+ getUnitInfoMap,
+ lookupUnit,
+ lookupUnit',
+ -- * UnitInfo
+ UnitInfo,
+ unitExposedModules,
+ unitDepends,
+ unitHaddockInterfaces,
+ unitInfoId,
+ unitPackageNameString,
+ unitPackageVersion,
+ -- * UnitId helpers
+ UnitId,
+ Unit,
+ unitString,
+ stringToUnit,
+#if !MIN_VERSION_ghc(9,0,0)
+ pattern RealUnit,
+#endif
+ definiteUnitId,
+ defUnitId,
+ installedModule,
+ -- * Module
+ toUnitId,
+ moduleUnitId,
+ moduleUnit,
+ -- * ExternalPackageState
+ ExternalPackageState(..),
+ -- * Utils
+ filterInplaceUnits,
+ ) where
+
+#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Data.ShortText as ST
+import GHC.Driver.Env (hsc_unit_dbs)
+import GHC.Unit.Env
+import GHC.Unit.External
+#else
+import GHC.Driver.Types
+#endif
+import GHC.Data.FastString
+import GHC.Driver.Session (PackageArg (..),
+ PackageFlag (..))
+import qualified GHC.Driver.Session as DynFlags
+import GHC.Types.Unique.Set
+import qualified GHC.Unit.Info as UnitInfo
+import GHC.Unit.Module.Name (ModuleName)
+import GHC.Unit.State (LookupResult, PackageName,
+ UnitInfo,
+ UnitState (unitInfoMap))
+import qualified GHC.Unit.State as State
+import GHC.Unit.Types hiding (moduleUnit, toUnitId)
+import qualified GHC.Unit.Types as Unit
+#else
+import DynFlags (PackageArg (..),
+ PackageFlag (..))
+import qualified DynFlags
+import FastString
+import HscTypes
+import Module hiding (moduleUnitId)
+import qualified Module
+import Packages (InstalledPackageInfo (haddockInterfaces, packageName),
+ LookupResult, PackageConfig,
+ PackageConfigMap, PackageName,
+ PackageState,
+ getPackageConfigMap,
+ lookupPackage')
+import qualified Packages
+#endif
+
+import Development.IDE.GHC.Compat.Env
+#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
+import Data.Map (Map)
+#endif
+import Data.Either
+import Data.Version
+
+#if MIN_VERSION_ghc(9,0,0)
+type PreloadUnitClosure = UniqSet UnitId
+#if MIN_VERSION_ghc(9,2,0)
+type UnitInfoMap = State.UnitInfoMap
+#else
+type UnitInfoMap = Map UnitId UnitInfo
+#endif
+#else
+type UnitState = PackageState
+type UnitInfo = PackageConfig
+type UnitInfoMap = PackageConfigMap
+type PreloadUnitClosure = ()
+type Unit = UnitId
+#endif
+
+
+#if !MIN_VERSION_ghc(9,0,0)
+unitString :: Unit -> String
+unitString = Module.unitIdString
+
+stringToUnit :: String -> Unit
+stringToUnit = Module.stringToUnitId
+#endif
+
+unitState :: HscEnv -> UnitState
+#if MIN_VERSION_ghc(9,2,0)
+unitState = ue_units . hsc_unit_env
+#elif MIN_VERSION_ghc(9,0,0)
+unitState = DynFlags.unitState . hsc_dflags
+#else
+unitState = DynFlags.pkgState . hsc_dflags
+#endif
+
+initUnits :: HscEnv -> IO HscEnv
+initUnits env = do
+#if MIN_VERSION_ghc(9,2,0)
+ let dflags1 = hsc_dflags env
+ -- Copied from GHC.setSessionDynFlags
+ let cached_unit_dbs = hsc_unit_dbs env
+ (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags1 cached_unit_dbs
+
+ dflags <- updatePlatformConstants dflags1 mconstants
+
+
+ let unit_env = UnitEnv
+ { ue_platform = targetPlatform dflags
+ , ue_namever = ghcNameVersion dflags
+ , ue_home_unit = home_unit
+ , ue_units = unit_state
+ }
+ pure $ hscSetFlags dflags $ hscSetUnitEnv unit_env env
+ { hsc_unit_dbs = Just dbs
+ }
+#elif MIN_VERSION_ghc(9,0,0)
+ newFlags <- State.initUnits $ hsc_dflags env
+ pure $ hscSetFlags newFlags env
+#else
+ newFlags <- fmap fst . Packages.initPackages $ hsc_dflags env
+ pure $ hscSetFlags newFlags env
+#endif
+
+explicitUnits :: UnitState -> [Unit]
+explicitUnits ue =
+#if MIN_VERSION_ghc(9,0,0)
+ State.explicitUnits ue
+#else
+ Packages.explicitPackages ue
+#endif
+
+listVisibleModuleNames :: HscEnv -> [ModuleName]
+listVisibleModuleNames env =
+#if MIN_VERSION_ghc(9,0,0)
+ State.listVisibleModuleNames $ unitState env
+#else
+ Packages.listVisibleModuleNames $ hsc_dflags env
+#endif
+
+getUnitName :: HscEnv -> UnitId -> Maybe PackageName
+getUnitName env i =
+#if MIN_VERSION_ghc(9,0,0)
+ State.unitPackageName <$> State.lookupUnitId (unitState env) i
+#else
+ packageName <$> Packages.lookupPackage (hsc_dflags env) (definiteUnitId (defUnitId i))
+#endif
+
+lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult
+lookupModuleWithSuggestions env modname mpkg =
+#if MIN_VERSION_ghc(9,0,0)
+ State.lookupModuleWithSuggestions (unitState env) modname mpkg
+#else
+ Packages.lookupModuleWithSuggestions (hsc_dflags env) modname mpkg
+#endif
+
+getUnitInfoMap :: HscEnv -> UnitInfoMap
+getUnitInfoMap =
+#if MIN_VERSION_ghc(9,2,0)
+ unitInfoMap . ue_units . hsc_unit_env
+#elif MIN_VERSION_ghc(9,0,0)
+ unitInfoMap . unitState
+#else
+ Packages.getPackageConfigMap . hsc_dflags
+#endif
+
+lookupUnit :: HscEnv -> Unit -> Maybe UnitInfo
+#if MIN_VERSION_ghc(9,0,0)
+lookupUnit env pid = State.lookupUnit (unitState env) pid
+#else
+lookupUnit env pid = Packages.lookupPackage (hsc_dflags env) pid
+#endif
+
+lookupUnit' :: Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo
+#if MIN_VERSION_ghc(9,0,0)
+lookupUnit' = State.lookupUnit'
+#else
+lookupUnit' b pcm _ u = Packages.lookupPackage' b pcm u
+#endif
+
+preloadClosureUs :: HscEnv -> PreloadUnitClosure
+#if MIN_VERSION_ghc(9,2,0)
+preloadClosureUs = State.preloadClosure . unitState
+#elif MIN_VERSION_ghc(9,0,0)
+preloadClosureUs = State.preloadClosure . unitState
+#else
+preloadClosureUs = const ()
+#endif
+
+unitExposedModules :: UnitInfo -> [(ModuleName, Maybe Module)]
+unitExposedModules ue =
+#if MIN_VERSION_ghc(9,0,0)
+ UnitInfo.unitExposedModules ue
+#else
+ Packages.exposedModules ue
+#endif
+
+unitDepends :: UnitInfo -> [UnitId]
+#if MIN_VERSION_ghc(9,0,0)
+unitDepends = State.unitDepends
+#else
+unitDepends = fmap (Module.DefiniteUnitId. defUnitId') . Packages.depends
+#endif
+
+unitPackageNameString :: UnitInfo -> String
+unitPackageNameString =
+#if MIN_VERSION_ghc(9,0,0)
+ UnitInfo.unitPackageNameString
+#else
+ Packages.packageNameString
+#endif
+
+unitPackageVersion :: UnitInfo -> Version
+unitPackageVersion =
+#if MIN_VERSION_ghc(9,0,0)
+ UnitInfo.unitPackageVersion
+#else
+ Packages.packageVersion
+#endif
+
+unitInfoId :: UnitInfo -> Unit
+unitInfoId =
+#if MIN_VERSION_ghc(9,0,0)
+ UnitInfo.mkUnit
+#else
+ Packages.packageConfigId
+#endif
+
+unitHaddockInterfaces :: UnitInfo -> [FilePath]
+unitHaddockInterfaces =
+#if MIN_VERSION_ghc(9,2,0)
+ fmap ST.unpack . UnitInfo.unitHaddockInterfaces
+#elif MIN_VERSION_ghc(9,0,0)
+ UnitInfo.unitHaddockInterfaces
+#else
+ haddockInterfaces
+#endif
+
+-- ------------------------------------------------------------------
+-- Backwards Compatible UnitState
+-- ------------------------------------------------------------------
+
+-- ------------------------------------------------------------------
+-- Patterns and helpful definitions
+-- ------------------------------------------------------------------
+
+#if MIN_VERSION_ghc(9,2,0)
+definiteUnitId = RealUnit
+defUnitId = Definite
+installedModule = Module
+
+#elif MIN_VERSION_ghc(9,0,0)
+definiteUnitId = RealUnit
+defUnitId = Definite
+installedModule = Module
+
+#else
+pattern RealUnit :: Module.DefUnitId -> UnitId
+pattern RealUnit x = Module.DefiniteUnitId x
+
+definiteUnitId :: Module.DefUnitId -> UnitId
+definiteUnitId = Module.DefiniteUnitId
+
+defUnitId :: UnitId -> Module.DefUnitId
+defUnitId = Module.DefUnitId . Module.toInstalledUnitId
+
+defUnitId' :: Module.InstalledUnitId -> Module.DefUnitId
+defUnitId' = Module.DefUnitId
+
+installedModule :: UnitId -> ModuleName -> Module.InstalledModule
+installedModule uid modname = Module.InstalledModule (Module.toInstalledUnitId uid) modname
+#endif
+
+toUnitId :: Unit -> UnitId
+toUnitId =
+#if MIN_VERSION_ghc(9,0,0)
+ Unit.toUnitId
+#else
+ id
+#endif
+
+moduleUnitId :: Module -> UnitId
+moduleUnitId =
+#if MIN_VERSION_ghc(9,0,0)
+ Unit.toUnitId . Unit.moduleUnit
+#else
+ Module.moduleUnitId
+#endif
+
+moduleUnit :: Module -> Unit
+moduleUnit =
+#if MIN_VERSION_ghc(9,0,0)
+ Unit.moduleUnit
+#else
+ Module.moduleUnitId
+#endif
+
+filterInplaceUnits :: [UnitId] -> [PackageFlag] -> ([UnitId], [PackageFlag])
+filterInplaceUnits us packageFlags =
+ partitionEithers (map isInplace packageFlags)
+ where
+ isInplace :: PackageFlag -> Either UnitId PackageFlag
+ isInplace p@(ExposePackage _ (UnitIdArg u) _) =
+#if MIN_VERSION_ghc(9,0,0)
+ if toUnitId u `elem` us
+ then Left $ toUnitId u
+ else Right p
+#else
+ if u `elem` us
+ then Left u
+ else Right p
+#endif
+ isInplace p = Right p
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs
new file mode 100644
index 0000000000000000000000000000000000000000..198a94c03b418fd250888f16db68a9f8e5bb8fb3
--- /dev/null
+++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+-- | GHC Utils and Datastructures re-exports.
+--
+-- Mainly handles module hierarchy re-organisation of GHC
+-- from version < 9.0 to >= 9.0.
+--
+-- Some Functions, such as 'toList' shadow other function-names.
+-- This way this module can be imported qualified more naturally.
+module Development.IDE.GHC.Compat.Util (
+ -- * Exception handling
+ MonadCatch,
+ GhcException,
+ handleGhcException,
+ catch,
+ try,
+ -- * Bags
+ Bag,
+ bagToList,
+ listToBag,
+ unionBags,
+ isEmptyBag,
+ -- * Boolean Formula
+ LBooleanFormula,
+ BooleanFormula(..),
+ -- * OverridingBool
+ OverridingBool(..),
+ -- * Maybes
+ MaybeErr(..),
+ orElse,
+#if MIN_VERSION_ghc(8,10,0)
+ -- * Pair
+ Pair(..),
+#endif
+ -- * EnumSet
+ EnumSet,
+ toList,
+ -- * FastString exports
+ FastString,
+#if MIN_VERSION_ghc(9,2,0)
+ -- Export here, so we can coerce safely on consumer sites
+ LexicalFastString(..),
+#endif
+ uniq,
+ unpackFS,
+ mkFastString,
+ fsLit,
+ pprHsString,
+ -- * Fingerprint
+ Fingerprint(..),
+ getFileHash,
+ fingerprintData,
+ fingerprintString,
+ fingerprintFingerprints,
+ -- * Unique
+ Uniquable,
+ nonDetCmpUnique,
+ getUnique,
+ Unique,
+ mkUnique,
+ newTagUnique,
+ -- * String Buffer
+ StringBuffer(..),
+ hGetStringBuffer,
+ stringToStringBuffer,
+ ) where
+
+#if MIN_VERSION_ghc(9,0,0)
+import Control.Exception.Safe (MonadCatch, catch, try)
+import GHC.Data.Bag
+import GHC.Data.BooleanFormula
+import GHC.Data.EnumSet
+
+import GHC.Data.FastString
+import GHC.Data.Maybe
+import GHC.Data.Pair
+import GHC.Data.StringBuffer
+import GHC.Types.Unique
+import GHC.Utils.Fingerprint
+import GHC.Utils.Misc
+import GHC.Utils.Outputable (pprHsString)
+import GHC.Utils.Panic hiding (try)
+#else
+import Bag
+import BooleanFormula
+import EnumSet
+import qualified Exception
+import FastString
+import Fingerprint
+import Maybes
+#if MIN_VERSION_ghc(8,10,0)
+import Pair
+#endif
+import Outputable (pprHsString)
+import Panic hiding (try)
+import StringBuffer
+import Unique
+import Util
+#endif
+
+#if !MIN_VERSION_ghc(9,0,0)
+type MonadCatch = Exception.ExceptionMonad
+
+-- We are using Safe here, which is not equivalent, but probably what we want.
+catch :: (Exception.ExceptionMonad m, Exception e) => m a -> (e -> m a) -> m a
+catch = Exception.gcatch
+
+try :: (Exception.ExceptionMonad m, Exception e) => m a -> m (Either e a)
+try = Exception.gtry
+#endif
diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs
index f025957e8d98862ba5cf3f1fb37d6a20f292d341..6abb3917a4b26a109d5886b751c963508d18e81a 100644
--- a/ghcide/src/Development/IDE/GHC/Error.hs
+++ b/ghcide/src/Development/IDE/GHC/Error.hs
@@ -29,22 +29,19 @@ module Development.IDE.GHC.Error
, toDSeverity
) where
-import Bag
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text as T
-import qualified Development.IDE.GHC.Compat as GHC
+import Development.IDE.GHC.Compat (DecoratedSDoc, MsgEnvelope,
+ errMsgSeverity, errMsgSpan,
+ formatErrorWithQual,
+ srcErrorMessages)
+import qualified Development.IDE.GHC.Compat as Compat
+import qualified Development.IDE.GHC.Compat.Util as Compat
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics as D
import Development.IDE.Types.Location
-import ErrUtils
-import qualified FastString as FS
import GHC
-import HscTypes
-import qualified Outputable as Out
-import Panic
-import SrcLoc
-
diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
@@ -60,32 +57,25 @@ diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFileP
}
-- | Produce a GHC-style error from a source span and a message.
-diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
+diagFromErrMsg :: T.Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic]
diagFromErrMsg diagSource dflags e =
[ diagFromText diagSource sev (errMsgSpan e)
$ T.pack $ formatErrorWithQual dflags e
| Just sev <- [toDSeverity $ errMsgSeverity e]]
-formatErrorWithQual :: DynFlags -> ErrMsg -> String
-formatErrorWithQual dflags e =
- Out.showSDoc dflags
- $ Out.withPprStyle (GHC.oldMkErrStyle dflags $ errMsgContext e)
- $ GHC.oldFormatErrDoc dflags
- $ ErrUtils.errMsgDoc e
-
-diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
-diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
+diagFromErrMsgs :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic]
+diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . Compat.bagToList
-- | Convert a GHC SrcSpan to a DAML compiler Range
srcSpanToRange :: SrcSpan -> Maybe Range
-srcSpanToRange (UnhelpfulSpan _) = Nothing
-srcSpanToRange (GHC.OldRealSrcSpan real) = Just $ realSrcSpanToRange real
+srcSpanToRange (UnhelpfulSpan _) = Nothing
+srcSpanToRange (Compat.RealSrcSpan real _) = Just $ realSrcSpanToRange real
-- srcSpanToRange = fmap realSrcSpanToRange . realSpan
realSrcSpanToRange :: RealSrcSpan -> Range
realSrcSpanToRange real =
- Range (realSrcLocToPosition $ realSrcSpanStart real)
- (realSrcLocToPosition $ realSrcSpanEnd real)
+ Range (realSrcLocToPosition $ Compat.realSrcSpanStart real)
+ (realSrcLocToPosition $ Compat.realSrcSpanEnd real)
realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition real =
@@ -95,12 +85,12 @@ realSrcLocToPosition real =
-- FIXME This may not be an _absolute_ file name, needs fixing.
srcSpanToFilename :: SrcSpan -> Maybe FilePath
srcSpanToFilename (UnhelpfulSpan _) = Nothing
-srcSpanToFilename (GHC.OldRealSrcSpan real) = Just $ FS.unpackFS $ srcSpanFile real
+srcSpanToFilename (Compat.RealSrcSpan real _) = Just $ Compat.unpackFS $ srcSpanFile real
-- srcSpanToFilename = fmap (FS.unpackFS . srcSpanFile) . realSpan
realSrcSpanToLocation :: RealSrcSpan -> Location
realSrcSpanToLocation real = Location file (realSrcSpanToRange real)
- where file = fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ FS.unpackFS $ srcSpanFile real
+ where file = fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ Compat.unpackFS $ srcSpanFile real
srcSpanToLocation :: SrcSpan -> Maybe Location
srcSpanToLocation src = do
@@ -110,18 +100,18 @@ srcSpanToLocation src = do
pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng
rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan
-rangeToSrcSpan = fmap GHC.OldRealSrcSpan . rangeToRealSrcSpan
+rangeToSrcSpan = fmap (\x -> Compat.RealSrcSpan x Nothing) . rangeToRealSrcSpan
rangeToRealSrcSpan
:: NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan nfp =
- mkRealSrcSpan
+ Compat.mkRealSrcSpan
<$> positionToRealSrcLoc nfp . _start
<*> positionToRealSrcLoc nfp . _end
positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc
positionToRealSrcLoc nfp (Position l c)=
- mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1)
+ Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1)
isInsideSrcSpan :: Position -> SrcSpan -> Bool
p `isInsideSrcSpan` r = case srcSpanToRange r of
@@ -152,19 +142,19 @@ diagFromString diagSource sev sp x = [diagFromText diagSource sev sp $ T.pack x]
-- | Produces an "unhelpful" source span with the given string.
noSpan :: String -> SrcSpan
-noSpan = GHC.oldUnhelpfulSpan . FS.fsLit
+noSpan = Compat.mkGeneralSrcSpan . Compat.fsLit
-- | creates a span with zero length in the filename of the argument passed
-zeroSpan :: FS.FastString -- ^ file path of span
+zeroSpan :: Compat.FastString -- ^ file path of span
-> RealSrcSpan
-zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1)
+zeroSpan file = Compat.realSrcLocSpan (Compat.mkRealSrcLoc file 1 1)
realSpan :: SrcSpan
-> Maybe RealSrcSpan
realSpan = \case
- GHC.OldRealSrcSpan r -> Just r
- UnhelpfulSpan _ -> Nothing
+ Compat.RealSrcSpan r _ -> Just r
+ UnhelpfulSpan _ -> Nothing
-- | Catch the errors thrown by GHC (SourceErrors and
@@ -172,7 +162,7 @@ realSpan = \case
-- diagnostics
catchSrcErrors :: DynFlags -> T.Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors dflags fromWhere ghcM = do
- handleGhcException (ghcExceptionToDiagnostics dflags) $
+ Compat.handleGhcException (ghcExceptionToDiagnostics dflags) $
handleSourceError (sourceErrorToDiagnostics dflags) $
Right <$> ghcM
where
@@ -192,14 +182,14 @@ showGHCE dflags exc = case exc of
-> unwords ["Compilation Issue:", s, "\n", requestReport]
PprPanic s sdoc
-> unlines ["Compilation Issue", s,""
- , Out.showSDoc dflags sdoc
+ , Compat.showSDoc dflags sdoc
, requestReport ]
Sorry s
-> "Unsupported feature: " <> s
PprSorry s sdoc
-> unlines ["Unsupported feature: ", s,""
- , Out.showSDoc dflags sdoc]
+ , Compat.showSDoc dflags sdoc]
---------- errors below should not happen at all --------
@@ -216,6 +206,6 @@ showGHCE dflags exc = case exc of
-> "Program error: " <> str
PprProgramError str sdoc ->
unlines ["Program error:", str,""
- , Out.showSDoc dflags sdoc]
+ , Compat.showSDoc dflags sdoc]
where
requestReport = "Please report this bug to the compiler authors."
diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index bf564452d4512a348fbcba2cb096dcafb1162063..8ce27a9f3bfe7c1d9deb7d8512f3f44b05e54e08 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -29,10 +29,11 @@ module Development.IDE.GHC.ExactPrint
Anns,
Annotate,
setPrecedingLinesT,
+ -- * Helper function
+ eqSrcSpan,
)
where
-import BasicTypes (appPrec)
import Control.Applicative (Alternative)
import Control.Arrow
import Control.Monad
@@ -53,7 +54,9 @@ import Data.Traversable (for)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake
-import Development.IDE.GHC.Compat hiding (parseExpr)
+import Development.IDE.GHC.Compat hiding (parseImport,
+ parsePattern,
+ parseType)
import Development.IDE.Graph (RuleResult, Rules)
import Development.IDE.Graph.Classes
import Development.IDE.Types.Location
@@ -65,9 +68,6 @@ import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Parsers
import Language.LSP.Types
import Language.LSP.Types.Capabilities (ClientCapabilities)
-import Outputable (Outputable, ppr,
- showSDoc)
-import Parser (parseIdentifier)
import Retrie.ExactPrint hiding (parseDecl,
parseExpr,
parsePattern,
@@ -233,8 +233,9 @@ graft' needs_space dst val = Graft $ \dflags a -> do
everywhere'
( mkT $
\case
- (L src _ :: Located ast) | src == dst -> val'
- l -> l
+ (L src _ :: Located ast)
+ | src `eqSrcSpan` dst -> val'
+ l -> l
)
a
@@ -267,7 +268,7 @@ getNeedsSpaceAndParenthesize dst a =
let (needs_parens, needs_space) =
everythingWithContext (Nothing, Nothing) (<>)
( mkQ (mempty, ) $ \x s -> case x of
- (L src _ :: LHsExpr GhcPs) | src == dst ->
+ (L src _ :: LHsExpr GhcPs) | src `eqSrcSpan` dst ->
(s, s)
L _ x' -> (mempty, Just *** Just $ needsParensSpace x')
) a
@@ -291,7 +292,7 @@ graftExprWithM dst trans = Graft $ \dflags a -> do
( mkM $
\case
val@(L src _ :: LHsExpr GhcPs)
- | src == dst -> do
+ | src `eqSrcSpan` dst -> do
mval <- trans val
case mval of
Just val' -> do
@@ -316,7 +317,7 @@ graftWithM dst trans = Graft $ \dflags a -> do
( mkM $
\case
val@(L src _ :: Located ast)
- | src == dst -> do
+ | src `eqSrcSpan` dst -> do
mval <- trans val
case mval of
Just val' -> do
@@ -368,7 +369,7 @@ graftDecls dst decs0 = Graft $ \dflags a -> do
annotateDecl dflags decl
let go [] = DL.empty
go (L src e : rest)
- | src == dst = DL.fromList decs <> DL.fromList rest
+ | src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest
| otherwise = DL.singleton (L src e) <> go rest
modifyDeclsT (pure . DL.toList . go) a
@@ -399,7 +400,7 @@ graftDeclsWithM ::
graftDeclsWithM dst toDecls = Graft $ \dflags a -> do
let go [] = pure DL.empty
go (e@(L src _) : rest)
- | src == dst = toDecls e >>= \case
+ | src `eqSrcSpan` dst = toDecls e >>= \case
Just decs0 -> do
decs <- forM decs0 $ \decl ->
hoistTransform (either Fail.fail pure) $
@@ -519,3 +520,9 @@ render dflags = showSDoc dflags . ppr
parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs
parenthesize = parenthesizeHsExpr appPrec
+------------------------------------------------------------------------------
+
+-- | Equality on SrcSpan's.
+-- Ignores the (Maybe BufSpan) field of SrcSpan's.
+eqSrcSpan :: SrcSpan -> SrcSpan -> Bool
+eqSrcSpan l r = leftmost_smallest l r == EQ
diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs
index 97c38b1d583d540eff798bec3c146673a4b30d23..a04fd1e86df7adcb8f4c0910d4fa6f86b5d12d95 100644
--- a/ghcide/src/Development/IDE/GHC/Orphans.hs
+++ b/ghcide/src/Development/IDE/GHC/Orphans.hs
@@ -9,20 +9,34 @@
-- Note that the 'NFData' instances may not be law abiding.
module Development.IDE.GHC.Orphans() where
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Data.Bag
+import GHC.Data.FastString
+import qualified GHC.Data.StringBuffer as SB
+import GHC.Types.Name.Occurrence
+import GHC.Types.SrcLoc
+import GHC.Types.Unique (getKey)
+import GHC.Unit.Info
+import GHC.Utils.Outputable
+#else
import Bag
+import GhcPlugins
+import qualified StringBuffer as SB
+import Unique (getKey)
+#endif
+
+import GHC
+
+import Retrie.ExactPrint (Annotated)
+
+import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Util
+
import Control.DeepSeq
import Data.Aeson
import Data.Hashable
import Data.String (IsString (fromString))
import Data.Text (Text)
-import Development.IDE.GHC.Compat
-import Development.IDE.GHC.Util
-import GHC ()
-import GhcPlugins
-import Retrie.ExactPrint (Annotated)
-import qualified StringBuffer as SB
-import Unique (getKey)
-
-- Orphan instances for types from the GHC API.
instance Show CoreModule where show = prettyPrint
@@ -50,7 +64,7 @@ instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS
instance Hashable GhcPlugins.InstalledUnitId where
hashWithSalt salt = hashWithSalt salt . installedUnitIdString
#else
-instance Show InstalledUnitId where show = prettyPrint
+instance Show UnitId where show = prettyPrint
deriving instance Ord SrcSpan
deriving instance Ord UnhelpfulSpanReason
#endif
@@ -93,8 +107,10 @@ deriving instance Show SourceModified
instance NFData SourceModified where
rnf = rwhnf
+#if !MIN_VERSION_ghc(9,2,0)
instance Show ModuleName where
show = moduleNameString
+#endif
instance Hashable ModuleName where
hashWithSalt salt = hashWithSalt salt . show
diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs
index fd13dd8f272463a712ffd7982bfe0281262ec1b9..1e3568086b3714ecc4d9cf26b0990e8cdd30ab72 100644
--- a/ghcide/src/Development/IDE/GHC/Util.hs
+++ b/ghcide/src/Development/IDE/GHC/Util.hs
@@ -10,7 +10,7 @@ module Development.IDE.GHC.Util(
prettyPrint,
unsafePrintSDoc,
printRdrName,
- printName,
+ Development.IDE.GHC.Util.printName,
ParseResult(..), runParser,
lookupPackageConfig,
textToStringBuffer,
@@ -30,48 +30,78 @@ module Development.IDE.GHC.Util(
disableWarningsAsErrors,
) where
+#if MIN_VERSION_ghc(9,2,0)
+import GHC
+import GHC.Core.Multiplicity
+import qualified GHC.Core.TyCo.Rep as TyCoRep
+import GHC.Data.FastString
+import GHC.Data.StringBuffer
+import GHC.Driver.Env
+import GHC.Driver.Env.Types
+import GHC.Driver.Monad
+import GHC.Driver.Session hiding (ExposePackage)
+import qualified GHC.Driver.Session as DynFlags
+import GHC.Hs.Extension
+import qualified GHC.Hs.Type as GHC
+import GHC.Iface.Env (updNameCache)
+import GHC.Iface.Make (mkIfaceExports)
+import qualified GHC.Linker.Types as LinkerTypes
+import GHC.Parser.Lexer
+import GHC.Runtime.Context
+import GHC.Tc.Types (TcGblEnv (tcg_exports))
+import GHC.Tc.Utils.TcType (pprSigmaType)
+import GHC.Types.Avail
+import GHC.Types.Name.Cache
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
+import GHC.Types.SrcLoc
+import qualified GHC.Types.SrcLoc as SrcLoc
+import GHC.Unit.Env
+import GHC.Unit.Info (PackageName)
+import qualified GHC.Unit.Info as Packages
+import qualified GHC.Unit.Module.Location as Module
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module.ModGuts
+import GHC.Unit.Module.ModIface (mi_mod_hash)
+import GHC.Unit.Module.Name (moduleNameSlashes)
+import qualified GHC.Unit.State as Packages
+import GHC.Unit.Types (IsBootInterface (..),
+ unitString)
+import qualified GHC.Unit.Types as Module
+import GHC.Utils.Fingerprint
+import GHC.Utils.Outputable
+import qualified GHC.Utils.Outputable as Outputable
+#endif
import Control.Concurrent
-import Control.Exception
-import Data.Binary.Put (Put, runPut)
-import qualified Data.ByteString as BS
-import Data.ByteString.Internal (ByteString (..))
-import qualified Data.ByteString.Internal as BS
-import qualified Data.ByteString.Lazy as LBS
+import Control.Exception as E
+import Data.Binary.Put (Put, runPut)
+import qualified Data.ByteString as BS
+import Data.ByteString.Internal (ByteString (..))
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.Lazy as LBS
import Data.IORef
import Data.List.Extra
import Data.Maybe
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Encoding.Error as T
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
import Data.Typeable
-import Development.IDE.GHC.Compat as GHC
+import Development.IDE.GHC.Compat as GHC
+import qualified Development.IDE.GHC.Compat.Parser as Compat
+import qualified Development.IDE.GHC.Compat.Units as Compat
+import Development.IDE.GHC.Compat.Util
import Development.IDE.Types.Location
-import FastString (mkFastString)
-import FileCleanup
-import Fingerprint
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
-import GHC.IO.BufferedIO (BufferedIO)
-import GHC.IO.Device as IODevice
+import GHC
+import GHC.IO.BufferedIO (BufferedIO)
+import GHC.IO.Device as IODevice
import GHC.IO.Encoding
import GHC.IO.Exception
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
-import GhcMonad
-import HscTypes (CgGuts, HscEnv (hsc_dflags),
- ModDetails, cg_binds,
- cg_module, hsc_IC, ic_dflags,
- md_types)
-import Lexer
-import Module (moduleNameSlashes)
-import OccName (parenSymOcc)
-import Outputable (Depth (..), Outputable, SDoc,
- neverQualify, ppr,
- showSDocUnsafe)
-import RdrName (nameRdrName, rdrNameOcc)
-import SrcLoc (mkRealSrcLoc)
-import StringBuffer
+
import System.FilePath
@@ -86,19 +116,15 @@ modifyDynFlags f = do
-- We do not use setSessionDynFlags here since we handle package
-- initialization separately.
modifySession $ \h ->
- h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
+ hscSetFlags newFlags h { hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
-- | Given a 'Unit' try and find the associated 'PackageConfig' in the environment.
-lookupPackageConfig :: Unit -> HscEnv -> Maybe GHC.PackageConfig
+lookupPackageConfig :: Unit -> HscEnv -> Maybe GHC.UnitInfo
lookupPackageConfig unit env =
- -- GHC.lookupPackage' False pkgConfigMap unit
- GHC.lookupUnit' False pkgConfigMap prClsre unit
+ Compat.lookupUnit' False unitState prClsre unit
where
- pkgConfigMap =
- -- For some weird reason, the GHC API does not provide a way to get the PackageConfigMap
- -- from PackageState so we have to wrap it in DynFlags first.
- getPackageConfigMap $ hsc_dflags env
- prClsre = preloadClosureUs $ hsc_dflags env
+ unitState = Compat.getUnitInfoMap env
+ prClsre = preloadClosureUs env
-- | Convert from the @text@ package to the @GHC@ 'StringBuffer'.
@@ -112,7 +138,7 @@ runParser flags str parser = unP parser parseState
filename = "<interactive>"
location = mkRealSrcLoc (mkFastString filename) 1 1
buffer = stringToStringBuffer str
- parseState = mkPState flags buffer location
+ parseState = Compat.initParserState (Compat.initParserOpts flags) buffer location
stringBufferToByteString :: StringBuffer -> ByteString
stringBufferToByteString StringBuffer{..} = PS buf cur len
@@ -125,9 +151,7 @@ prettyPrint :: Outputable a => a -> String
prettyPrint = unsafePrintSDoc . ppr
unsafePrintSDoc :: SDoc -> String
-unsafePrintSDoc sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags neverQualify AllTheWay)
- where
- dflags = unsafeGlobalDynFlags
+unsafePrintSDoc sdoc = showSDocUnsafe sdoc
-- | Pretty print a 'RdrName' wrapping operators in parens
printRdrName :: RdrName -> String
@@ -148,13 +172,9 @@ evalGhcEnv env act = snd <$> runGhcEnv env act
-- pieces, but designed to be more efficient than a standard 'runGhc'.
runGhcEnv :: HscEnv -> Ghc a -> IO (HscEnv, a)
runGhcEnv env act = do
- filesToClean <- newIORef emptyFilesToClean
- dirsToClean <- newIORef mempty
- let dflags = (hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True}
- ref <- newIORef env{hsc_dflags=dflags}
- res <- unGhc act (Session ref) `finally` do
- cleanTempFiles dflags
- cleanTempDirs dflags
+ hsc_env <- initTempFs env
+ ref <- newIORef hsc_env
+ res <- unGhc (withCleanupSession act) (Session ref)
(,res) <$> readIORef ref
-- | Given a module location, and its parse tree, figure out what is the include directory implied by it.
@@ -218,7 +238,7 @@ hDuplicateTo' h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
-- _ <- hClose_help h2_
-- hClose_help does two things:
-- 1. It flushes the buffer, we replicate this here
- _ <- flushWriteBuffer h2_ `catch` \(_ :: IOException) -> pure ()
+ _ <- flushWriteBuffer h2_ `E.catch` \(_ :: IOException) -> pure ()
-- 2. It closes the handle. This is redundant since dup2 takes care of that
-- but even worse it is actively harmful! Once the handle has been closed
-- another thread is free to reallocate it. This leads to dup2 failing with EBUSY
diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs
index df7ef0fb395dd8f3adcc98c2b5cdd7bfe0654cd0..720828fef3caa5616616ecf0611c966a51263131 100644
--- a/ghcide/src/Development/IDE/GHC/Warnings.hs
+++ b/ghcide/src/Development/IDE/GHC/Warnings.hs
@@ -4,15 +4,11 @@
module Development.IDE.GHC.Warnings(withWarnings) where
-import Data.List
-import ErrUtils
-import GhcPlugins as GHC hiding (Var, (<>))
-
import Control.Concurrent.Strict
+import Data.List
import qualified Data.Text as T
-import Development.IDE.GHC.Compat (LogActionCompat,
- logActionCompat)
+import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.Types.Diagnostics
import Language.LSP.Types (type (|?) (..))
@@ -27,16 +23,20 @@ import Language.LSP.Types (type (|?) (..))
-- https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640
-- which basically says that log_action is taken from the ModSummary when GHC feels like it.
-- The given argument lets you refresh a ModSummary log_action
-withWarnings :: T.Text -> ((ModSummary -> ModSummary) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a)
+withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a)
withWarnings diagSource action = do
warnings <- newVar []
let newAction :: LogActionCompat
newAction dynFlags wr _ loc prUnqual msg = do
let wr_d = map ((wr,) . third3 (attachReason wr)) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc prUnqual msg
modifyVar_ warnings $ return . (wr_d:)
- res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = logActionCompat newAction}}
+ newLogger env = pushLogHook (const (logActionCompat newAction)) (hsc_logger env)
+ res <- action $ \env -> putLogHook (newLogger env) env
warns <- readVar warnings
return (reverse $ concat warns, res)
+ where
+ third3 :: (c -> d) -> (a, b, c) -> (a, b, d)
+ third3 f (a, b, c) = (a, b, f c)
attachReason :: WarnReason -> Diagnostic -> Diagnostic
attachReason wr d = d{_code = InR <$> showReason wr}
diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs
index 572a17c569881bb6f338be357c936ced0e00dfe6..101e21fe32df76178621decaa79b4eb57f4e18a4 100644
--- a/ghcide/src/Development/IDE/Import/FindImports.hs
+++ b/ghcide/src/Development/IDE/Import/FindImports.hs
@@ -13,25 +13,19 @@ module Development.IDE.Import.FindImports
, mkImportDirs
) where
+import Control.DeepSeq
import Development.IDE.GHC.Compat as Compat
+import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error as ErrUtils
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
--- GHC imports
-import Control.DeepSeq
-import FastString
-import Finder
-import qualified Module as M
-import Outputable (ppr, pprPanic, showSDoc)
-import Packages
-- standard imports
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.List (isSuffixOf)
import Data.Maybe
-import DriverPhases
import System.FilePath
data Import
@@ -75,7 +69,7 @@ locateModuleFile :: MonadIO m
-> m (Maybe NormalizedFilePath)
locateModuleFile import_dirss exts targetFor isSource modName = do
let candidates import_dirs =
- [ toNormalizedFilePath' (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
+ [ toNormalizedFilePath' (prefix </> moduleNameSlashes modName <.> maybeBoot ext)
| prefix <- import_dirs , ext <- exts]
firstJustM (targetFor modName) (concatMap candidates import_dirss)
where
@@ -87,22 +81,22 @@ locateModuleFile import_dirss exts targetFor isSource modName = do
-- It only returns Just for unit-ids which are possible to import into the
-- current module. In particular, it will return Nothing for 'main' components
-- as they can never be imported into another package.
-mkImportDirs :: DynFlags -> (Compat.InstalledUnitId, DynFlags) -> Maybe (PackageName, [FilePath])
-mkImportDirs df (i, DynFlags{importPaths}) = (, importPaths) <$> getPackageName df i
+mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [FilePath])
+mkImportDirs env (i, flags) = (, importPaths flags) <$> getUnitName env i
-- | locate a module in either the file system or the package database. Where we go from *daml to
-- Haskell
locateModule
:: MonadIO m
- => DynFlags
- -> [(Compat.InstalledUnitId, DynFlags)] -- ^ Import directories
+ => HscEnv
+ -> [(UnitId, DynFlags)] -- ^ Import directories
-> [String] -- ^ File extensions
-> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -- ^ does file exist predicate
-> Located ModuleName -- ^ Module name
-> Maybe FastString -- ^ Package name
-> Bool -- ^ Is boot module
-> m (Either [FileDiagnostic] Import)
-locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do
+locateModule env comp_info exts targetFor modName mbPkgName isSource = do
case mbPkgName of
-- "this" means that we should only look in the current package
Just "this" -> do
@@ -111,7 +105,7 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do
Just pkgName
| Just dirs <- lookup (PackageName pkgName) import_paths
-> lookupLocal [dirs]
- | otherwise -> lookupInPackageDB dflags
+ | otherwise -> lookupInPackageDB env
Nothing -> do
-- first try to find the module as a file. If we can't find it try to find it in the package
-- database.
@@ -120,10 +114,11 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do
-- each component will end up being found in the wrong place and cause a multi-cradle match failure.
mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts targetFor isSource $ unLoc modName
case mbFile of
- Nothing -> lookupInPackageDB dflags
+ Nothing -> lookupInPackageDB env
Just file -> toModLocation file
where
- import_paths = mapMaybe (mkImportDirs dflags) comp_info
+ dflags = hsc_dflags env
+ import_paths = mapMaybe (mkImportDirs env) comp_info
toModLocation file = liftIO $ do
loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource)
@@ -131,20 +126,21 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do
lookupLocal dirs = do
mbFile <- locateModuleFile dirs exts targetFor isSource $ unLoc modName
case mbFile of
- Nothing -> return $ Left $ notFoundErr dflags modName $ LookupNotFound []
+ Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound []
Just file -> toModLocation file
- lookupInPackageDB dfs =
- case oldLookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of
+ lookupInPackageDB env =
+ case Compat.lookupModuleWithSuggestions env (unLoc modName) mbPkgName of
LookupFound _m _pkgConfig -> return $ Right PackageImport
- reason -> return $ Left $ notFoundErr dfs modName reason
+ reason -> return $ Left $ notFoundErr env modName reason
-- | Don't call this on a found module.
-notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnostic]
-notFoundErr dfs modName reason =
- mkError' $ ppr' $ cannotFindModule dfs modName0 $ lookupToFindResult reason
+notFoundErr :: HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic]
+notFoundErr env modName reason =
+ mkError' $ ppr' $ cannotFindModule env modName0 $ lookupToFindResult reason
where
- mkError' = diagFromString "not found" DsError (getLoc modName)
+ dfs = hsc_dflags env
+ mkError' = diagFromString "not found" DsError (Compat.getLoc modName)
modName0 = unLoc modName
ppr' = showSDoc dfs
-- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer.
@@ -155,12 +151,12 @@ notFoundErr dfs modName reason =
LookupMultiple rs -> FoundMultiple rs
LookupHidden pkg_hiddens mod_hiddens ->
notFound
- { fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens
- , fr_mods_hidden = map (moduleUnitId . fst) mod_hiddens
+ { fr_pkgs_hidden = map (moduleUnit . fst) pkg_hiddens
+ , fr_mods_hidden = map (moduleUnit . fst) mod_hiddens
}
LookupUnusable unusable ->
let unusables' = map get_unusable unusable
- get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
+ get_unusable (m, ModUnusable r) = (moduleUnit m, r)
get_unusable (_, r) =
pprPanic "findLookupResult: unexpected origin" (ppr r)
in notFound {fr_unusables = unusables'}
diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs
index 44714f23d711a398975bf12b0d2f9d9ac526f282..82bdc573cd4dc8e0a532207277b63d3dbd2c08b6 100644
--- a/ghcide/src/Development/IDE/LSP/Outline.hs
+++ b/ghcide/src/Development/IDE/LSP/Outline.hs
@@ -29,8 +29,6 @@ import Language.LSP.Types (DocumentSymbol (..),
SymbolKind (SkConstructor, SkField, SkFile, SkFunction, SkInterface, SkMethod, SkModule, SkObject, SkStruct, SkTypeParameter, SkUnknown),
TextDocumentIdentifier (TextDocumentIdentifier),
type (|?) (InL), uriToFilePath)
-import Outputable (Outputable, ppr,
- showSDocUnsafe)
moduleOutline
:: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation))
@@ -44,7 +42,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif
-> let
declSymbols = mapMaybe documentSymbolForDecl hsmodDecls
moduleSymbol = hsmodName >>= \case
- (L (OldRealSrcSpan l) m) -> Just $
+ (L (RealSrcSpan l _) m) -> Just $
(defDocumentSymbol l :: DocumentSymbol)
{ _name = pprText m
, _kind = SkFile
@@ -73,7 +71,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif
Nothing -> pure $ Right $ InL (List [])
documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
-documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
+documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName n
<> (case pprText fdTyVars of
@@ -83,7 +81,7 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ FamDecl { tcdFam = FamilyDe
, _detail = Just $ pprText fdInfo
, _kind = SkFunction
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
+documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
<> (case pprText tcdTyVars of
@@ -99,11 +97,11 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _
, _kind = SkMethod
, _selectionRange = realSrcSpanToRange l'
}
- | L (OldRealSrcSpan l) (ClassOpSig _ False names _) <- tcdSigs
- , L (OldRealSrcSpan l') n <- names
+ | L (RealSrcSpan l _) (ClassOpSig _ False names _) <- tcdSigs
+ , L (RealSrcSpan l' _) n <- names
]
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
+documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
, _kind = SkStruct
@@ -115,8 +113,8 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ n
, _selectionRange = realSrcSpanToRange l'
, _children = conArgRecordFields (con_args x)
}
- | L (OldRealSrcSpan l ) x <- dd_cons
- , L (OldRealSrcSpan l') n <- getConNames' x
+ | L (RealSrcSpan l _ ) x <- dd_cons
+ , L (RealSrcSpan l' _) n <- getConNames' x
]
}
where
@@ -127,48 +125,48 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ n
, _kind = SkField
}
| L _ cdf <- lcdfs
- , L (OldRealSrcSpan l) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
+ , L (RealSrcSpan l _) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf
]
conArgRecordFields _ = Nothing
-documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ SynDecl { tcdLName = L (OldRealSrcSpan l') n })) = Just
+documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ SynDecl { tcdLName = L (RealSrcSpan l' _) n })) = Just
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
, _kind = SkTypeParameter
, _selectionRange = realSrcSpanToRange l'
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
+documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
, _kind = SkInterface
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
+documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
(map pprText feqn_pats)
, _kind = SkInterface
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
+documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
= Just (defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
(map pprText feqn_pats)
, _kind = SkInterface
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (DerivD _ DerivDecl { deriv_type })) =
+documentSymbolForDecl (L (RealSrcSpan l _) (DerivD _ DerivDecl { deriv_type })) =
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
name
, _kind = SkInterface
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (ValD _ FunBind{fun_id = L _ name})) = Just
+documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ FunBind{fun_id = L _ name})) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = showRdrName name
, _kind = SkFunction
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (ValD _ PatBind{pat_lhs})) = Just
+documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ PatBind{pat_lhs})) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = pprText pat_lhs
, _kind = SkFunction
}
-documentSymbolForDecl (L (OldRealSrcSpan l) (ForD _ x)) = Just
+documentSymbolForDecl (L (RealSrcSpan l _) (ForD _ x)) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = case x of
ForeignImport{} -> name
@@ -202,7 +200,7 @@ documentSymbolForImportSummary importSymbols =
}
documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol
-documentSymbolForImport (L (OldRealSrcSpan l) ImportDecl { ideclName, ideclQualified }) = Just
+documentSymbolForImport (L (RealSrcSpan l _) ImportDecl { ideclName, ideclQualified }) = Just
(defDocumentSymbol l :: DocumentSymbol)
{ _name = "import " <> pprText ideclName
, _kind = SkModule
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
index 43354a11e9fb642265ea861657bc33b879de68c8..edabeab3dd98c4894629ceef14c5bd24d05430d0 100644
--- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -18,8 +18,6 @@ module Development.IDE.Plugin.CodeAction
, matchRegExMultipleImports
) where
-import Bag (bagToList,
- isEmptyBag)
import Control.Applicative ((<|>))
import Control.Arrow (second,
(>>>))
@@ -44,6 +42,7 @@ import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Rules
import Development.IDE.Core.Service
import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util (prettyPrint,
printRdrName,
@@ -57,8 +56,6 @@ import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified GHC.LanguageExtensions as Lang
-import HscTypes (ImportedModsVal (..),
- importedByUser)
import Ide.PluginUtils (subRange)
import Ide.Types
import qualified Language.LSP.Server as LSP
@@ -77,18 +74,6 @@ import Language.LSP.Types (CodeAction (
type (|?) (InR),
uriToFilePath)
import Language.LSP.VFS
-import Module (moduleEnvElts)
-import OccName
-import Outputable (Outputable,
- ppr,
- showSDoc,
- showSDocUnsafe)
-import RdrName (GlobalRdrElt (..),
- lookupGlobalRdrEnv)
-import SrcLoc (realSrcSpanEnd,
- realSrcSpanStart)
-import TcRnTypes (ImportAvails (..),
- TcGblEnv (..))
import Text.Regex.TDFA (mrAfter,
(=~), (=~~))
@@ -256,7 +241,7 @@ suggestHideShadow ps@(L _ HsModule {hsmodImports}) fileContents mTcM mHar Diagno
| Just tcM <- mTcM,
Just har <- mHar,
[s'] <- [x | (x, "") <- readSrcSpan $ T.unpack s],
- isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (OldRealSrcSpan s'),
+ isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (RealSrcSpan s' Nothing),
mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,
title <- "Hide " <> identifier <> " from " <> modName =
if modName == "Prelude" && null mDecl
@@ -440,10 +425,10 @@ suggestDeleteUnusedBinding
findRelatedSpans
indexedContent
name
- (L (OldRealSrcSpan l) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
+ (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =
case lname of
(L nLoc _name) | isTheBinding nLoc ->
- let findSig (L (OldRealSrcSpan l) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig
+ let findSig (L (RealSrcSpan l _) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig
findSig _ = []
in
extendForSpaces indexedContent (toRange l) :
@@ -466,7 +451,7 @@ suggestDeleteUnusedBinding
let maybeSpan = findRelatedSigSpan1 name sig
in case maybeSpan of
Just (_span, True) -> pure $ extendForSpaces indexedContent $ toRange l -- a :: Int
- Just (OldRealSrcSpan span, False) -> pure $ toRange span -- a, b :: Int, a is unused
+ Just (RealSrcSpan span _, False) -> pure $ toRange span -- a, b :: Int, a is unused
_ -> []
-- Second of the tuple means there is only one match
@@ -517,10 +502,10 @@ suggestDeleteUnusedBinding
indexedContent
name
lsigs
- (L (OldRealSrcSpan l) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) =
+ (L (RealSrcSpan l _) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) =
if isTheBinding (getLoc lname)
then
- let findSig (L (OldRealSrcSpan l) sig) = findRelatedSigSpan indexedContent name l sig
+ let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig
findSig _ = []
in extendForSpaces indexedContent (toRange l) : concatMap findSig lsigs
else concatMap (findRelatedSpanForMatch indexedContent name) matches
@@ -562,7 +547,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
-- we get the last export and the closing bracket and check for comma in that range
needsComma :: T.Text -> Located [LIE GhcPs] -> Bool
needsComma _ (L _ []) = False
- needsComma source (L (OldRealSrcSpan l) exports) =
+ needsComma source (L (RealSrcSpan l _) exports) =
let closeParan = _end $ realSrcSpanToRange l
lastExport = fmap _end . getLocatedRange $ last exports
in case lastExport of
@@ -690,7 +675,7 @@ newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -
newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ
| Range _ lastLineP : _ <-
[ realSrcSpanToRange sp
- | (L l@(OldRealSrcSpan sp) _) <- hsmodDecls
+ | (L l@(RealSrcSpan sp _) _) <- hsmodDecls
, _start `isInsideSrcSpan` l]
, nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0}
= [ ("Define " <> sig
@@ -1015,10 +1000,10 @@ disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case
liftParseAST @(HsExpr GhcPs) df $
prettyPrint $
HsVar @GhcPs noExtField $
- L (oldUnhelpfulSpan "") rdr
+ L (mkGeneralSrcSpan "") rdr
else Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->
liftParseAST @RdrName df $
- prettyPrint $ L (oldUnhelpfulSpan "") rdr
+ prettyPrint $ L (mkGeneralSrcSpan "") rdr
]
findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
@@ -1316,7 +1301,7 @@ findPositionNoImports (Just hsmodName) _ _ = findPositionFromImportsOrModuleDecl
findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int)
findPositionFromImportsOrModuleDecl hsField f hasImports = case getLoc (f hsField) of
- OldRealSrcSpan s ->
+ RealSrcSpan s _ ->
let col = calcCol s
in Just ((srcLocLine (realSrcSpanEnd s), col), col)
_ -> Nothing
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
index 2f552e782f28a25caa77737f51190a8f648e80a5..b79775c8c4c938369916cbd1417c2be4eea57b74 100644
--- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
@@ -29,21 +29,17 @@ import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isNothing,
mapMaybe)
import qualified Data.Text as T
-import Development.IDE.GHC.Compat hiding (parseExpr)
+import Development.IDE.GHC.Compat
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint (ASTElement (parseAST),
Annotate)
import Development.IDE.Spans.Common
-import FieldLabel (flLabel)
import GHC.Exts (IsList (fromList))
-import GhcPlugins (mkRdrUnqual, sigPrec)
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
KeywordId (G), mkAnnKey)
import Language.LSP.Types
-import OccName
-import Outputable (ppr, showSDocUnsafe)
-import Retrie.GHC (rdrNameOcc, unpackFS)
------------------------------------------------------------------------------
@@ -453,5 +449,5 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do
ty
wild
(filter ((/= symbol) . unqualIEWrapName . unLoc) cons)
- (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds)
+ (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds)
killLie v = Just v
diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs
index 9b1b203262c1f067d7d75a08dbce9ffae7976e58..7a52d0a0baccf43ab1008550cca2356d10c6aec3 100644
--- a/ghcide/src/Development/IDE/Plugin/Completions.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
@@ -31,7 +30,6 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA)
import Development.IDE.GHC.Util (prettyPrint)
import Development.IDE.Graph
import Development.IDE.Graph.Classes
-import Development.IDE.Import.FindImports
import Development.IDE.Plugin.CodeAction (newImport,
newImportToEdit)
import Development.IDE.Plugin.CodeAction.ExactPrint
@@ -48,11 +46,6 @@ import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Language.LSP.VFS as VFS
-#if MIN_VERSION_ghc(9,0,0)
-import GHC.Tc.Module (tcRnImportDecls)
-#else
-import TcRnDriver (tcRnImportDecls)
-#endif
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
index c3f1de1a4a33ee886599b907805834dbade65fba..fbf66ab3662bb3e8317f1e0a733371d54858ed9d 100644
--- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -26,27 +26,17 @@ import Data.Maybe (fromMaybe, isJust,
import qualified Data.Text as T
import qualified Text.Fuzzy as Fuzzy
-import HscTypes
-import Name
-import RdrName
-import Type
-#if MIN_VERSION_ghc(8,10,0)
-import Coercion
-import Pair
-import Predicate (isDictTy)
-#endif
-
-import ConLike
import Control.Monad
import Data.Aeson (ToJSON (toJSON))
import Data.Either (fromRight)
import Data.Functor
import qualified Data.HashMap.Strict as HM
-import qualified Data.Set as Set
import qualified Data.HashSet as HashSet
+import qualified Data.Set as Set
import Development.IDE.Core.Compile
import Development.IDE.Core.PositionMapping
-import Development.IDE.GHC.Compat as GHC
+import Development.IDE.GHC.Compat as GHC hiding (ppr)
+import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util
import Development.IDE.Plugin.Completions.Types
@@ -56,15 +46,12 @@ import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Options
-import GhcPlugins (flLabel, unpackFS)
import Ide.PluginUtils (mkLspCommand)
import Ide.Types (CommandId (..),
PluginId)
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.VFS as VFS
-import Outputable (Outputable)
-import TyCoRep
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
@@ -266,7 +253,7 @@ mkNameCompItem doc thingParent origName origMod thingType isInfix docs !imp = CI
getArgs t
| isPredTy t = []
| isDictTy t = []
- | isForAllTy t = getArgs $ snd (splitForAllTys t)
+ | isForAllTy t = getArgs $ snd (splitForAllTyCoVars t)
| isFunTy t =
let (args, ret) = splitFunTys t
in if isForAllTy ret
@@ -334,7 +321,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
packageState = hscEnv env
curModName = moduleName curMod
- importMap = Map.fromList [ (l, imp) | imp@(L (OldRealSrcSpan l) _) <- limports ]
+ importMap = Map.fromList [ (l, imp) | imp@(L (RealSrcSpan l _) _) <- limports ]
iDeclToModName :: ImportDecl name -> ModuleName
iDeclToModName = unLoc . ideclName
@@ -611,8 +598,8 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
| otherwise = []
if
- -- TODO: handle multiline imports
- | "import " `T.isPrefixOf` fullLine
+ -- TODO: handle multiline imports
+ | "import " `T.isPrefixOf` fullLine
&& (List.length (words (T.unpack fullLine)) >= 2)
&& "(" `isInfixOf` T.unpack fullLine
-> do
diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs
index b8660887b6e84b43463695cf83b4536e431e91bb..3eea61d146e7967040488b592b3e6c50f0941b2f 100644
--- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs
@@ -9,11 +9,11 @@ module Development.IDE.Plugin.Completions.Types (
import Control.DeepSeq
import qualified Data.Map as Map
import qualified Data.Text as T
-import SrcLoc
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import Development.IDE.Spans.Common
+import Development.IDE.GHC.Compat
import GHC.Generics (Generic)
import Ide.Plugin.Config (Config)
import Ide.Plugin.Properties
diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs
index 1dbe0b2a3838e7e19d9c8a8a55a7c0ec4226bacc..7a1a9469ac5f620a6ee1a60c0c381574057ea89c 100644
--- a/ghcide/src/Development/IDE/Plugin/Test.hs
+++ b/ghcide/src/Development/IDE/Plugin/Test.hs
@@ -28,13 +28,11 @@ import Development.IDE.Core.Shake
import Development.IDE.GHC.Compat
import Development.IDE.Graph (Action)
import Development.IDE.LSP.Server
-import Development.IDE.Plugin
import qualified Development.IDE.Plugin as P
import Development.IDE.Types.Action
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
import Development.IDE.Types.Location (fromUri)
import GHC.Generics (Generic)
-import GhcPlugins (HscEnv (hsc_dflags))
import Ide.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
@@ -52,7 +50,7 @@ data TestRequest
newtype WaitForIdeRuleResult = WaitForIdeRuleResult { ideResultSuccess::Bool}
deriving newtype (FromJSON, ToJSON)
-plugin :: Plugin c
+plugin :: P.Plugin c
plugin = def {
P.pluginRules = return (),
P.pluginHandlers = requestHandler (SCustomMethod "test") testRequestHandler'
diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs
index 327ac655135fbd5018696d8d629109f2a51f5f5b..6ce6001fa30905d7ce1cf77c7959971613654681 100644
--- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs
+++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs
@@ -12,7 +12,6 @@ module Development.IDE.Plugin.TypeLenses (
GlobalBindingTypeSigsResult (..),
) where
-import Avail (availsToNameSet)
import Control.DeepSeq (rwhnf)
import Control.Monad (mzero)
import Control.Monad.Extra (whenMaybe)
@@ -42,13 +41,6 @@ import Development.IDE.Types.Location (Position (Position, _chara
toNormalizedFilePath',
uriToFilePath')
import GHC.Generics (Generic)
-import GhcPlugins (GlobalRdrEnv,
- HscEnv (hsc_dflags), SDoc,
- elemNameSet, getSrcSpan,
- idName, mkRealSrcLoc,
- realSrcLocSpan,
- tidyOpenType)
-import HscTypes (mkPrintUnqualified)
import Ide.Plugin.Config (Config)
import Ide.Plugin.Properties
import Ide.PluginUtils (mkLspCommand,
@@ -73,16 +65,6 @@ import Language.LSP.Types (ApplyWorkspaceEditParams (
TextDocumentIdentifier (TextDocumentIdentifier),
TextEdit (TextEdit),
WorkspaceEdit (WorkspaceEdit))
-import Outputable (showSDocForUser)
-import PatSyn (PatSyn, mkPatSyn,
- patSynBuilder,
- patSynFieldLabels,
- patSynIsInfix,
- patSynMatcher, patSynName,
- patSynSig, pprPatSynType)
-import TcEnv (tcInitTidyEnv)
-import TcRnMonad (initTcWithGbl)
-import TcRnTypes (TcGblEnv (..))
import Text.Regex.TDFA ((=~), (=~~))
typeLensCommandId :: T.Text
@@ -185,7 +167,7 @@ suggestLocalSignature isQuickFix mTmr mBindings Diagnostic{_message, _range = _r
, Just TcModuleResult{tmrTypechecked = TcGblEnv{tcg_rdr_env, tcg_sigs}} <- mTmr
, -- not a top-level thing, to avoid duplication
not $ name `elemNameSet` tcg_sigs
- , tyMsg <- showSDocForUser unsafeGlobalDynFlags (mkPrintUnqualified unsafeGlobalDynFlags tcg_rdr_env) $ pprSigmaType ty
+ , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault tcg_rdr_env) $ pprSigmaType ty
, signature <- T.pack $ printName name <> " :: " <> tyMsg
, startCharacter <- _character _start
, startOfLine <- Position (_line _start) startCharacter
@@ -229,8 +211,8 @@ instance A.FromJSON Mode where
--------------------------------------------------------------------------------
-showDocRdrEnv :: DynFlags -> GlobalRdrEnv -> SDoc -> String
-showDocRdrEnv dflags rdrEnv = showSDocForUser dflags (mkPrintUnqualified dflags rdrEnv)
+showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String
+showDocRdrEnv env rdrEnv = showSDocForUser (hsc_dflags env) (mkPrintUnqualified (hsc_dflags env) rdrEnv)
data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs
deriving (Generic, Show, Eq, Ord, Hashable, NFData, Binary)
@@ -269,9 +251,8 @@ gblBindingType (Just hsc) (Just gblEnv) = do
sigs = tcg_sigs gblEnv
binds = collectHsBindsBinders $ tcg_binds gblEnv
patSyns = tcg_patsyns gblEnv
- dflags = hsc_dflags hsc
rdrEnv = tcg_rdr_env gblEnv
- showDoc = showDocRdrEnv dflags rdrEnv
+ showDoc = showDocRdrEnv hsc rdrEnv
hasSig :: (Monad m) => Name -> m a -> m (Maybe a)
hasSig name f = whenMaybe (name `elemNameSet` sigs) f
bindToSig id = do
diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs
index 2c878ebe1be82006d348a166c1b82e8dd270aeec..36bdd58303ace659ac49e52b7af5f9164fbe634a 100644
--- a/ghcide/src/Development/IDE/Spans/AtPoint.hs
+++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs
@@ -30,25 +30,16 @@ import Language.LSP.Types
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.Spans.Common
import Development.IDE.Types.Options
--- GHC API imports
-import FastString (unpackFS)
-import IfaceType
-import Name
-import NameEnv
-import Outputable hiding ((<>))
-import SrcLoc
-import TyCoRep hiding (FunTy)
-import TyCon
-import qualified Var
-
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
+import Data.Coerce (coerce)
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -130,12 +121,12 @@ referencesAtPoint hiedb nfp pos refs = do
Just mod -> do
-- Look for references (strictly in project files, not dependencies),
-- excluding the files in the FOIs (since those are in foiRefs)
- rows <- liftIO $ findReferences hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) exclude
+ rows <- liftIO $ findReferences hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude
pure $ mapMaybe rowToLoc rows
typeRefs <- forM names $ \name ->
case nameModule_maybe name of
Just mod | isTcClsNameSpace (occNameSpace $ nameOccName name) -> do
- refs <- liftIO $ findTypeRefs hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) exclude
+ refs <- liftIO $ findTypeRefs hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude
pure $ mapMaybe typeRowToLoc refs
_ -> pure []
pure $ nubOrd $ foiRefs ++ concat nonFOIRefs ++ concat typeRefs
@@ -208,10 +199,10 @@ atPoint
:: IdeOptions
-> HieAstResult
-> DocAndKindMap
- -> DynFlags
+ -> HscEnv
-> Position
-> Maybe (Maybe Range, [T.Text])
-atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ pointCommand hf pos hoverInfo
+atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ pointCommand hf pos hoverInfo
where
-- Hover info for values/data
hoverInfo ast = (Just range, prettyNames ++ pTypes)
@@ -240,10 +231,10 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ po
prettyPackageName n = do
m <- nameModule_maybe n
- let pid = moduleUnitId m
- conf <- lookupPackage df pid
- let pkgName = T.pack $ packageNameString conf
- version = T.pack $ showVersion (packageVersion conf)
+ let pid = moduleUnit m
+ conf <- lookupUnit env pid
+ let pkgName = T.pack $ unitPackageNameString conf
+ version = T.pack $ showVersion (unitPackageVersion conf)
pure $ " *(" <> pkgName <> "-" <> version <> ")*"
prettyTypes = map (("_ :: "<>) . prettyType) types
@@ -300,10 +291,10 @@ typeLocationsAtPoint hiedb lookupModule _ideOptions pos (HAR _ ast _ _ hieKind)
in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts)
namesInType :: Type -> [Name]
-namesInType (TyVarTy n) = [Var.varName n]
+namesInType (TyVarTy n) = [varName n]
namesInType (AppTy a b) = getTypes [a,b]
namesInType (TyConApp tc ts) = tyConName tc : getTypes ts
-namesInType (ForAllTy b t) = Var.varName (binderVar b) : namesInType t
+namesInType (ForAllTy b t) = varName (binderVar b) : namesInType t
namesInType (FunTy a b) = getTypes [a,b]
namesInType (CastTy t _) = namesInType t
namesInType (LitTy _) = []
@@ -333,9 +324,9 @@ locationsAtPoint hiedb lookupModule _ideOptions imports pos ast =
nameToLocation :: MonadIO m => HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation hiedb lookupModule name = runMaybeT $
case nameSrcSpan name of
- sp@(OldRealSrcSpan rsp)
+ sp@(RealSrcSpan rsp _)
-- Lookup in the db if we got a location in a boot file
- | fs <- unpackFS (srcSpanFile rsp)
+ | fs <- Util.unpackFS (srcSpanFile rsp)
, not $ "boot" `isSuffixOf` fs
-> do
itExists <- liftIO $ doesFileExist fs
@@ -353,7 +344,7 @@ nameToLocation hiedb lookupModule name = runMaybeT $
-- In this case the interface files contain garbage source spans
-- so we instead read the .hie files to get useful source spans.
mod <- MaybeT $ return $ nameModule_maybe name
- erow <- liftIO $ findDef hiedb (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod)
+ erow <- liftIO $ findDef hiedb (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod)
case erow of
[] -> do
-- If the lookup failed, try again without specifying a unit-id.
@@ -398,7 +389,17 @@ defRowToSymbolInfo _ = Nothing
pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand hf pos k =
catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast ->
- case selectSmallestContaining (sp fs) ast of
+ -- Since GHC 9.2:
+ -- getAsts :: Map HiePath (HieAst a)
+ -- type HiePath = LexialFastString
+ --
+ -- but before:
+ -- getAsts :: Map HiePath (HieAst a)
+ -- type HiePath = FastString
+ --
+ -- 'coerce' here to avoid an additional function for maintaining
+ -- backwards compatibility.
+ case selectSmallestContaining (sp $ coerce fs) ast of
Nothing -> Nothing
Just ast' -> Just $ k ast'
where
diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs
index 895379e89a5ae3b96dd54d6823f425d633c39e12..0a601201386bd7e306478e3cf81e7aaa2b468d1c 100644
--- a/ghcide/src/Development/IDE/Spans/Common.hs
+++ b/ghcide/src/Development/IDE/Spans/Common.hs
@@ -23,20 +23,13 @@ import Data.Maybe
import qualified Data.Text as T
import GHC.Generics
-import ConLike
-import DynFlags
import GHC
-import NameEnv
-import Outputable hiding ((<>))
-import Var
-import Development.IDE.GHC.Compat (oldMkUserStyle,
- oldRenderWithStyle)
+import Development.IDE.GHC.Compat
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
import qualified Documentation.Haddock.Parser as H
import qualified Documentation.Haddock.Types as H
-import RdrName (rdrNameOcc)
type DocMap = NameEnv SpanDoc
type KindMap = NameEnv TyThing
@@ -48,11 +41,7 @@ showSD :: SDoc -> T.Text
showSD = T.pack . unsafePrintSDoc
showNameWithoutUniques :: Outputable a => a -> T.Text
-showNameWithoutUniques = T.pack . prettyprint
- where
- dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques
- prettyprint x = oldRenderWithStyle dyn (ppr x) style
- style = oldMkUserStyle dyn neverQualify AllTheWay
+showNameWithoutUniques = T.pack . printNameWithoutUniques
-- | Shows IEWrappedName, without any modifier, qualifier or unique identifier.
unqualIEWrapName :: IEWrappedName RdrName -> T.Text
@@ -66,9 +55,9 @@ safeTyThingType (ATyCon tycon) = Just (tyConKind tycon)
safeTyThingType _ = Nothing
safeTyThingId :: TyThing -> Maybe Id
-safeTyThingId (AnId i) = Just i
-safeTyThingId (AConLike conLike) = conLikeWrapId_maybe conLike
-safeTyThingId _ = Nothing
+safeTyThingId (AnId i) = Just i
+safeTyThingId (AConLike (RealDataCon dataCon)) = Just (dataConWrapId dataCon)
+safeTyThingId _ = Nothing
-- Possible documentation for an element in the code
data SpanDoc
diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs
index 95cc889d40589b0165c18dcd8a09d90b63bcc1da..8afe4f72fe21ab3ed182c77cfc4e93d87e5bcabd 100644
--- a/ghcide/src/Development/IDE/Spans/Documentation.hs
+++ b/ghcide/src/Development/IDE/Spans/Documentation.hs
@@ -13,6 +13,7 @@ module Development.IDE.Spans.Documentation (
) where
import Control.Monad
+import Control.Monad.IO.Class
import Control.Monad.Extra (findM)
import Data.Either
import Data.Foldable
@@ -24,20 +25,13 @@ import qualified Data.Text as T
import Development.IDE.Core.Compile
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error
import Development.IDE.Spans.Common
import System.Directory
import System.FilePath
-import ExtractDocs
-import FastString
-import GhcMonad
-import HscTypes (HscEnv (hsc_dflags))
import Language.LSP.Types (filePathToUri, getUri)
-import Name
-import NameEnv
-import SrcLoc (RealLocated)
-import TcRnTypes
mkDocMap
:: HscEnv
@@ -86,12 +80,11 @@ getDocumentationsTryGhc env mod names = do
-- Get the uris to the documentation and source html pages if they exist
getUris name = do
- let df = hsc_dflags env
(docFu, srcFu) <-
case nameModule_maybe name of
Just mod -> liftIO $ do
- doc <- toFileUriText $ lookupDocHtmlForModule df mod
- src <- toFileUriText $ lookupSrcHtmlForModule df mod
+ doc <- toFileUriText $ lookupDocHtmlForModule env mod
+ src <- toFileUriText $ lookupSrcHtmlForModule env mod
return (doc, src)
Nothing -> pure (Nothing, Nothing)
let docUri = (<> "#" <> selector <> showNameWithoutUniques name) <$> docFu
@@ -183,28 +176,28 @@ docHeaders = mapMaybe (\(L _ x) -> wrk x)
-- | Given a module finds the local @doc/html/Foo-Bar-Baz.html@ page.
-- An example for a cabal installed module:
-- @~/.cabal/store/ghc-8.10.1/vctr-0.12.1.2-98e2e861/share/doc/html/Data-Vector-Primitive.html@
-lookupDocHtmlForModule :: DynFlags -> Module -> IO (Maybe FilePath)
+lookupDocHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath)
lookupDocHtmlForModule =
lookupHtmlForModule (\pkgDocDir modDocName -> pkgDocDir </> modDocName <.> "html")
-- | Given a module finds the hyperlinked source @doc/html/src/Foo.Bar.Baz.html@ page.
-- An example for a cabal installed module:
-- @~/.cabal/store/ghc-8.10.1/vctr-0.12.1.2-98e2e861/share/doc/html/src/Data.Vector.Primitive.html@
-lookupSrcHtmlForModule :: DynFlags -> Module -> IO (Maybe FilePath)
+lookupSrcHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath)
lookupSrcHtmlForModule =
lookupHtmlForModule (\pkgDocDir modDocName -> pkgDocDir </> "src" </> modDocName <.> "html")
-lookupHtmlForModule :: (FilePath -> FilePath -> FilePath) -> DynFlags -> Module -> IO (Maybe FilePath)
-lookupHtmlForModule mkDocPath df m = do
+lookupHtmlForModule :: (FilePath -> FilePath -> FilePath) -> HscEnv -> Module -> IO (Maybe FilePath)
+lookupHtmlForModule mkDocPath hscEnv m = do
-- try all directories
- let mfs = fmap (concatMap go) (lookupHtmls df ui)
+ let mfs = fmap (concatMap go) (lookupHtmls hscEnv ui)
html <- findM doesFileExist (concat . maybeToList $ mfs)
-- canonicalize located html to remove /../ indirection which can break some clients
-- (vscode on Windows at least)
traverse canonicalizePath html
where
go pkgDocDir = map (mkDocPath pkgDocDir) mns
- ui = moduleUnitId m
+ ui = moduleUnit m
-- try to locate html file from most to least specific name e.g.
-- first Language.LSP.Types.Uri.html and Language-Haskell-LSP-Types-Uri.html
-- then Language.LSP.Types.html and Language-Haskell-LSP-Types.html etc.
@@ -213,8 +206,8 @@ lookupHtmlForModule mkDocPath df m = do
-- The file might use "." or "-" as separator
map (`intercalate` chunks) [".", "-"]
-lookupHtmls :: DynFlags -> Unit -> Maybe [FilePath]
+lookupHtmls :: HscEnv -> Unit -> Maybe [FilePath]
lookupHtmls df ui =
-- use haddockInterfaces instead of haddockHTMLs: GHC treats haddockHTMLs as URL not path
-- and therefore doesn't expand $topdir on Windows
- map takeDirectory . haddockInterfaces <$> lookupPackage df ui
+ map takeDirectory . unitHaddockInterfaces <$> lookupUnit df ui
diff --git a/ghcide/src/Development/IDE/Spans/LocalBindings.hs b/ghcide/src/Development/IDE/Spans/LocalBindings.hs
index cf23e37040866159ef5c6021258b9cfae6645476..deb1668cfd0e5214803ad079847efee4d7a94e83 100644
--- a/ghcide/src/Development/IDE/Spans/LocalBindings.hs
+++ b/ghcide/src/Development/IDE/Spans/LocalBindings.hs
@@ -20,12 +20,13 @@ import qualified Data.Set as S
import Development.IDE.GHC.Compat (Name, RefMap, Scope (..), Type,
getBindSiteFromContext,
getScopeFromContext, identInfo,
- identType)
+ identType, NameEnv, nameEnvElts,
+ unitNameEnv, isSystemName,
+ RealSrcSpan, realSrcSpanStart,
+ realSrcSpanEnd)
+
import Development.IDE.GHC.Error
import Development.IDE.Types.Location
-import Name (isSystemName)
-import NameEnv
-import SrcLoc
------------------------------------------------------------------------------
-- | Turn a 'RealSrcSpan' into an 'Interval'.
diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs
index 58603efb1bc152f9a5547f1d81e4491236c6aace..cee3024105b52b6d46363ff5197550ff684a6f01 100644
--- a/ghcide/src/Development/IDE/Types/Exports.hs
+++ b/ghcide/src/Development/IDE/Types/Exports.hs
@@ -7,10 +7,11 @@ module Development.IDE.Types.Exports
createExportsMap,
createExportsMapMg,
createExportsMapTc,
- buildModuleExportMapFrom
-,createExportsMapHieDb,size) where
+ buildModuleExportMapFrom,
+ createExportsMapHieDb,
+ size,
+ ) where
-import Avail (AvailInfo (..))
import Control.DeepSeq (NFData (..))
import Control.Monad
import Data.Bifunctor (Bifunctor (second))
@@ -24,12 +25,8 @@ import Data.Text (Text, pack)
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Orphans ()
import Development.IDE.GHC.Util
-import FieldLabel (flSelector)
import GHC.Generics (Generic)
-import GhcPlugins (IfaceExport, ModGuts (..))
import HieDb
-import Name
-import TcRnTypes (TcGblEnv (..))
data ExportsMap = ExportsMap
@@ -81,8 +78,12 @@ renderIEWrapped n
occ = occName n
mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
-mkIdentInfos mod (Avail n) =
+mkIdentInfos mod (AvailName n) =
[IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
+mkIdentInfos mod (AvailFL fl) =
+ [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
+ where
+ n = flSelector fl
mkIdentInfos mod (AvailTC parent (n:nn) flds)
-- Following the GHC convention that parent == n if parent is exported
| n == parent
diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs
index bca62f96f4a16d61ac7056e9dcadf75601287270..efda6b23b9a4818dc9c20fa4ad12367439db95be 100644
--- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs
+++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs
@@ -11,37 +11,33 @@ module Development.IDE.Types.HscEnvEq
) where
-import Control.Concurrent.Async (Async, async, waitCatch)
-import Control.Concurrent.Strict (modifyVar, newVar)
-import Control.DeepSeq (force)
-import Control.Exception (evaluate, mask, throwIO)
-import Control.Monad.Extra (eitherM, join, mapMaybeM)
+import Control.Concurrent.Async (Async, async, waitCatch)
+import Control.Concurrent.Strict (modifyVar, newVar)
+import Control.DeepSeq (force)
+import Control.Exception (evaluate, mask, throwIO)
+import Control.Monad.Extra (eitherM, join, mapMaybeM)
import Control.Monad.IO.Class
-import Data.Either (fromRight)
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Unique
+import Data.Either (fromRight)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Unique (Unique)
+import qualified Data.Unique as Unique
import Development.IDE.GHC.Compat
-import Development.IDE.GHC.Error (catchSrcErrors)
-import Development.IDE.GHC.Util (lookupPackageConfig)
+import qualified Development.IDE.GHC.Compat.Util as Maybes
+import Development.IDE.GHC.Error (catchSrcErrors)
+import Development.IDE.GHC.Util (lookupPackageConfig)
import Development.IDE.Graph.Classes
-import Development.IDE.Types.Exports (ExportsMap, createExportsMap)
-import GhcPlugins (HscEnv (hsc_dflags))
-import LoadIface (loadInterface)
-import qualified Maybes
--- import Module (InstalledUnitId)
-import OpenTelemetry.Eventlog (withSpan)
-import System.Directory (canonicalizePath)
+import Development.IDE.Types.Exports (ExportsMap, createExportsMap)
+import OpenTelemetry.Eventlog (withSpan)
+import System.Directory (canonicalizePath)
import System.FilePath
-import TcRnMonad (WhereFrom (ImportByUser),
- initIfaceLoad)
-- | An 'HscEnv' with equality. Two values are considered equal
-- if they are created with the same call to 'newHscEnvEq'.
data HscEnvEq = HscEnvEq
{ envUnique :: !Unique
, hscEnv :: !HscEnv
- , deps :: [(InstalledUnitId, DynFlags)]
+ , deps :: [(UnitId, DynFlags)]
-- ^ In memory components for this HscEnv
-- This is only used at the moment for the import dirs in
-- the DynFlags
@@ -57,7 +53,7 @@ data HscEnvEq = HscEnvEq
}
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
-newHscEnvEq :: FilePath -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
+newHscEnvEq :: FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEq cradlePath hscEnv0 deps = do
let relativeToCradle = (takeDirectory cradlePath </>)
hscEnv = removeImportPaths hscEnv0
@@ -68,29 +64,29 @@ newHscEnvEq cradlePath hscEnv0 deps = do
newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps
-newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
+newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
let dflags = hsc_dflags hscEnv
- envUnique <- newUnique
+ envUnique <- Unique.newUnique
-- it's very important to delay the package exports computation
envPackageExports <- onceAsync $ withSpan "Package Exports" $ \_sp -> do
-- compute the package imports
- let pkgst = pkgState dflags
- depends = explicitPackages pkgst
+ let pkgst = unitState hscEnv
+ depends = explicitUnits pkgst
targets =
[ (pkg, mn)
| d <- depends
, Just pkg <- [lookupPackageConfig d hscEnv]
- , (mn, _) <- exposedModules pkg
+ , (mn, _) <- unitExposedModules pkg
]
doOne (pkg, mn) = do
modIface <- liftIO $ initIfaceLoad hscEnv $ loadInterface
""
- (mkModule (packageConfigId pkg) mn)
+ (mkModule (unitInfoId pkg) mn)
(ImportByUser NotBoot)
return $ case modIface of
Maybes.Failed _r -> Nothing
@@ -104,13 +100,13 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
<$> catchSrcErrors
dflags
"listVisibleModuleNames"
- (evaluate . force . Just $ oldListVisibleModuleNames dflags)
+ (evaluate . force . Just $ listVisibleModuleNames hscEnv)
return HscEnvEq{..}
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
newHscEnvEqPreserveImportPaths
- :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
+ :: HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing
-- | Unwrap the 'HscEnv' with the original import paths.
@@ -118,15 +114,15 @@ newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing
hscEnvWithImportPaths :: HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq{..}
| Just imps <- envImportPaths
- = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = Set.toList imps}}
+ = hscSetFlags (setImportPaths (Set.toList imps) (hsc_dflags hscEnv)) hscEnv
| otherwise
= hscEnv
removeImportPaths :: HscEnv -> HscEnv
-removeImportPaths hsc = hsc{hsc_dflags = (hsc_dflags hsc){importPaths = []}}
+removeImportPaths hsc = hscSetFlags (setImportPaths [] (hsc_dflags hsc)) hsc
instance Show HscEnvEq where
- show HscEnvEq{envUnique} = "HscEnvEq " ++ show (hashUnique envUnique)
+ show HscEnvEq{envUnique} = "HscEnvEq " ++ show (Unique.hashUnique envUnique)
instance Eq HscEnvEq where
a == b = envUnique a == envUnique b
@@ -134,7 +130,7 @@ instance Eq HscEnvEq where
instance NFData HscEnvEq where
rnf (HscEnvEq a b c d _ _) =
-- deliberately skip the package exports map and visible module names
- rnf (hashUnique a) `seq` b `seq` c `seq` rnf d
+ rnf (Unique.hashUnique a) `seq` b `seq` c `seq` rnf d
instance Hashable HscEnvEq where
hashWithSalt s = hashWithSalt s . envUnique
diff --git a/ghcide/src/Development/IDE/Types/Location.hs b/ghcide/src/Development/IDE/Types/Location.hs
index 7176499cedad865344d2f342c21a50609bed1349..24a61d8a27d687f53aac8a61a66e63d7a30c6dc3 100644
--- a/ghcide/src/Development/IDE/Types/Location.hs
+++ b/ghcide/src/Development/IDE/Types/Location.hs
@@ -31,11 +31,17 @@ import Control.Monad
import Data.Hashable (Hashable (hash))
import Data.Maybe (fromMaybe)
import Data.String
+
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Data.FastString
+import GHC.Types.SrcLoc as GHC
+#else
import FastString
+import SrcLoc as GHC
+#endif
import Language.LSP.Types (Location (..), Position (..),
Range (..))
import qualified Language.LSP.Types as LSP
-import SrcLoc as GHC
import Text.ParserCombinators.ReadP as ReadP
toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs
index 2968e54abfb5101ce1625ac16700a4d12fa2f2c3..7cd2ea7a3ad02bceef8ddff849e585b6d39d2cac 100644
--- a/ghcide/src/Development/IDE/Types/Options.hs
+++ b/ghcide/src/Development/IDE/Types/Options.hs
@@ -160,10 +160,10 @@ defaultSkipProgress key = case () of
-- | The set of options used to locate files belonging to external packages.
data IdePkgLocationOptions = IdePkgLocationOptions
- { optLocateHieFile :: PackageConfig -> Module -> IO (Maybe FilePath)
+ { optLocateHieFile :: UnitState -> Module -> IO (Maybe FilePath)
-- ^ Locate the HIE file for the given module. The PackageConfig can be
-- used to lookup settings like importDirs.
- , optLocateSrcFile :: PackageConfig -> Module -> IO (Maybe FilePath)
+ , optLocateSrcFile :: UnitState -> Module -> IO (Maybe FilePath)
-- ^ Locate the source file for the given module. The PackageConfig can be
-- used to lookup settings like importDirs. For DAML, we place them in the package DB.
-- For cabal this could point somewhere in ~/.cabal/packages.
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 9ed034eb94b8c1ad6488fe9f293899612f7822f5..8b0f10974460711fc70d41c972358c5993b26575 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -360,22 +360,6 @@ executable haskell-language-server
, transformers
, unordered-containers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
default-language: Haskell2010
default-extensions: DataKinds, TypeOperators
diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal
index fee9ceed1191786ae3fc4a9a86f238f5532edad3..feaece622ff5f33f714bbc0990cbae5f3641f04e 100644
--- a/hls-plugin-api/hls-plugin-api.cabal
+++ b/hls-plugin-api/hls-plugin-api.cabal
@@ -56,22 +56,6 @@ library
, text
, unordered-containers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
if os(windows)
build-depends: Win32
diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs
index ae3253f6f553adfb94916049240ebc376cbf239c..c83d2c6e89800c00b0e3f4bc07f58eade8469061 100644
--- a/hls-plugin-api/src/Ide/Types.hs
+++ b/hls-plugin-api/src/Ide/Types.hs
@@ -41,7 +41,7 @@ import Data.String
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Development.IDE.Graph
-import DynFlags (DynFlags)
+import GHC (DynFlags)
import GHC.Generics
import Ide.Plugin.Config
import Ide.Plugin.Properties
diff --git a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
index c4d4d7aa1bb647bbe821cf4ad5658a8c7d622990..91d46d844b55656e014d0e4b9f49cbc1a225b7ae 100644
--- a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
+++ b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs
@@ -13,7 +13,7 @@ import Data.Semigroup
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
-import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), topDir)
+import qualified Development.IDE.GHC.Compat as GHC hiding (Cpp)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC.LanguageExtensions.Type
@@ -41,7 +41,6 @@ import qualified Data.Text as Text
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import qualified Data.Text.Lazy as TextL
-import qualified DynFlags as GHC
import qualified GHC
import qualified GHC.LanguageExtensions.Type as GHC
@@ -61,8 +60,8 @@ provider ide typ contents nfp opts = liftIO $ do
FormatText -> (fullRange contents, contents)
FormatRange r -> (normalize r, extractRange r contents)
modsum <- fmap msrModSummary $ runAction "brittany" ide $ use_ GetModSummaryWithoutTimestamps nfp
- let dflags = ms_hspp_opts modsum
- let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)
+ let dflags = GHC.ms_hspp_opts modsum
+ let withRuntimeLibdir = bracket_ (setEnv key $ GHC.topDir dflags) (unsetEnv key)
where key = "GHC_EXACTPRINT_GHC_LIBDIR"
res <- withRuntimeLibdir $ formatText dflags confFile opts selectedContents
case res of
diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal
index 85a8cbb59b63cf8da2311f5e12ca6c388e28be31..d54d0d5677b0af289c2977d8808b2f0114b25eb6 100644
--- a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal
+++ b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal
@@ -42,22 +42,6 @@ library
default-language: Haskell2010
default-extensions: DataKinds
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
test-suite tests
type: exitcode-stdio-1.0
default-language: Haskell2010
diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs
index 602fb328f87cc0c6144dc009805f8a48fc3fbe38..e54c7721ab546b9eed8c59529c5788dae24df805 100644
--- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs
+++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs
@@ -37,7 +37,6 @@ import Ide.Plugin.CallHierarchy.Types
import Ide.Types
import Language.LSP.Types
import qualified Language.LSP.Types.Lens as L
-import Name
import Text.Read (readMaybe)
-- | Render prepare call hierarchy request.
diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs
index 1ba3a793f820584e97a3e239ce88962f3c43c9c7..9a855958c10e0f12691177e204c52c4bd19c6fb4 100644
--- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs
+++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs
@@ -14,7 +14,6 @@ import Development.IDE.GHC.Compat
import HieDb (HieDb (getConn), Symbol (..),
toNsChar)
import Ide.Plugin.CallHierarchy.Types
-import Name
incomingCalls :: HieDb -> Symbol -> IO [Vertex]
incomingCalls (getConn -> conn) symbol = do
@@ -78,5 +77,5 @@ parseSymbol :: Symbol -> (String, String, String)
parseSymbol Symbol{..} =
let o = toNsChar (occNameSpace symName) : occNameString symName
m = moduleNameString $ moduleName symModule
- u = unitString $ moduleUnitId symModule
+ u = unitString $ moduleUnit symModule
in (o, m, u)
diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal
index 76e0c31a17730be034042dc6fa3d894b9871946a..766965e1a9ef9ec6f73c10d954c91b22f25ebf13 100644
--- a/plugins/hls-class-plugin/hls-class-plugin.cabal
+++ b/plugins/hls-class-plugin/hls-class-plugin.cabal
@@ -36,22 +36,6 @@ library
, text
, transformers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
default-language: Haskell2010
default-extensions:
DataKinds
diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
index 6ec932e4a5f0dd0a41cd7b10c74b9f4676cd68b9..fa81a76c0724d59db3c1f1347d0664d30baa094c 100644
--- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
+++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
@@ -8,12 +8,10 @@ module Ide.Plugin.Class
( descriptor
) where
-import BooleanFormula
-import Class
-import ConLike
import Control.Applicative
import Control.Lens hiding (List, use)
import Control.Monad
+import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
@@ -26,10 +24,9 @@ import Development.IDE hiding (pluginHandlers)
import Development.IDE.Core.PositionMapping (fromCurrentRange,
toCurrentRange)
import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util
import Development.IDE.Spans.AtPoint
import qualified GHC.Generics as Generics
-import GhcPlugins hiding (Var, getLoc,
- (<>))
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.GHC.ExactPrint
@@ -38,8 +35,6 @@ import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens)
import Language.LSP.Server
import Language.LSP.Types
import qualified Language.LSP.Types.Lens as J
-import TcEnv
-import TcRnMonad
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
index c9ba87be6fe224e981008f19d6c3646fe54b0f86..16232b61cc1e4930b0f0420071aa5e1610f065ff 100644
--- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal
+++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -82,22 +82,6 @@ library
, unliftio
, unordered-containers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
ghc-options:
-Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs
index 7497ae783a6b312a1133072283e349034ee25ea2..be013e2dc27902b1ad913689ec621ad2deac0c25 100644
--- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs
+++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs
@@ -6,22 +6,20 @@
module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalSetup, propSetup, testCheck, asStatements,myExecStmt) where
import Control.Lens ((^.))
+import Control.Monad.IO.Class
import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff)
import qualified Data.List.NonEmpty as NE
import Data.String (IsString)
import qualified Data.Text as T
+import Development.IDE.GHC.Compat
import Development.IDE.Types.Location (Position (..), Range (..))
import GHC (ExecOptions, ExecResult (..),
execStmt)
-import GhcMonad (Ghc, liftIO, modifySession)
-import HscTypes
import Ide.Plugin.Eval.Types (Language (Plain), Loc,
Located (..),
Section (sectionLanguage),
Test (..), Txt, locate,
locate0)
-import InteractiveEval (getContext, parseImportDecl,
- runDecls, setContext)
import Language.LSP.Types.Lens (line, start)
import System.IO.Extra (newTempFile, readFile')
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 c7ef62b912a171f89f3c9f9fd33700bb6769d729..10b82027a556894d3fe68562eebde4d81665a4bf 100644
--- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
+++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
@@ -25,7 +25,6 @@ module Ide.Plugin.Eval.CodeLens (
evalCommand,
) where
-import CmdLineParser
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow (second, (>>>))
import Control.Exception (try)
@@ -72,59 +71,30 @@ import Development.IDE.Core.Compile (loadModulesHome,
setupFinderCache)
import Development.IDE.Core.PositionMapping (toCurrentRange)
import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps))
-import Development.IDE.GHC.Compat (AnnotationComment (AnnBlockComment, AnnLineComment),
- GenLocated (L),
- GhcException, HscEnv,
- ParsedModule (..),
- SrcSpan (UnhelpfulSpan),
- moduleName,
- setInteractiveDynFlags,
- srcSpanFile)
+import Development.IDE.GHC.Compat hiding (typeKind,
+ unitState)
+import qualified Development.IDE.GHC.Compat as Compat
import qualified Development.IDE.GHC.Compat as SrcLoc
+import Development.IDE.GHC.Compat.Util (GhcException,
+ OverridingBool (..))
+import qualified Development.IDE.GHC.Compat.Util as FastString
import Development.IDE.Types.Options
-import DynamicLoading (initializePlugins)
-import FastString (unpackFS)
import GHC (ClsInst,
ExecOptions (execLineNumber, execSourceFile),
- FamInst, Fixity,
- GeneralFlag (..), Ghc,
- GhcLink (LinkInMemory),
- GhcMode (CompManager),
- GhcMonad (getSession),
- HscTarget (HscInterpreted),
+ FamInst, GhcMonad,
LoadHowMuch (LoadAllTargets),
- ModSummary (ms_hspp_opts),
- NamedThing (getName, getOccName),
- SuccessFlag (Failed, Succeeded),
- TcRnExprMode (..),
- TyThing, defaultFixity,
+ NamedThing (getName),
+ defaultFixity,
execOptions, exprType,
getInfo,
getInteractiveDynFlags,
- getSessionDynFlags,
isImport, isStmt, load,
parseName, pprFamInst,
- pprInstance, runDecls,
- setContext, setLogAction,
- setSessionDynFlags,
- setTargets, typeKind)
+ pprInstance,
+ setLogAction, setTargets,
+ typeKind)
import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))
-import GhcPlugins (DynFlags (..),
- defaultLogActionHPutStrDoc,
- elemNameSet, gopt_set,
- gopt_unset, hsc_dflags,
- isSymOcc, mkNameSet,
- parseDynamicFlagsCmdLine,
- pprDefinedAt,
- pprInfixName,
- targetPlatform,
- tyThingParent_maybe,
- xopt_set, xopt_unset)
-
-import HscTypes (InteractiveImport (IIModule),
- ModSummary (ms_mod),
- Target (Target),
- TargetId (TargetFile))
+
import Ide.Plugin.Eval.Code (Statement, asStatements,
evalSetup, myExecStmt,
propSetup, resultRange,
@@ -146,28 +116,15 @@ import Language.LSP.Types hiding
SemanticTokenRelative (length))
import Language.LSP.Types.Lens (end, line)
import Language.LSP.VFS (virtualFileText)
-import Outputable (SDoc, empty, hang, nest,
- ppr, showSDoc, text,
- vcat, ($$), (<+>))
import System.FilePath (takeFileName)
import System.IO (hClose)
import UnliftIO.Temporary (withSystemTempFile)
-import Util (OverridingBool (Never))
-import IfaceSyn (showToHeader)
-import PprTyThing (pprTyThingInContext,
- pprTypeForUser)
#if MIN_VERSION_ghc(9,0,0)
-import GHC.Driver.Ways (hostFullWays,
- wayGeneralFlags,
- wayUnsetGeneralFlags)
-import GHC.Parser.Annotation (ApiAnns (apiAnnRogueComments))
-import GHC.Parser.Lexer (mkParserFlags)
+import GHC.Driver.Session (unitDatabases, unitState)
import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))
#else
-import GhcPlugins (interpWays, updateWays,
- wayGeneralFlags,
- wayUnsetGeneralFlags)
+import DynFlags
#endif
#if MIN_VERSION_ghc(9,0,0)
@@ -180,7 +137,7 @@ apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.Located AnnotationComment]
apiAnnComments' = concat . Map.elems . snd
pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcSpan
-pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x
+pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x Nothing
#endif
@@ -203,7 +160,7 @@ codeLens st plId CodeLensParams{_textDocument} =
let comments =
foldMap (\case
L (RealSrcSpanAlready real) bdy
- | unpackFS (srcSpanFile real) ==
+ | FastString.unpackFS (srcSpanFile real) ==
fromNormalizedFilePath nfp
, let ran0 = realSrcSpanToRange real
, Just curRan <- toCurrentRange posMap ran0
@@ -387,7 +344,7 @@ runEvalCmd st EvalParams{..} =
return $ Left err
Succeeded -> do
-- Evaluation takes place 'inside' the module
- setContext [IIModule modName]
+ setContext [Compat.IIModule modName]
Right <$> getSession
edits <-
@@ -601,11 +558,10 @@ evals (st, fp) df stmts = do
dbg "{DECL " stmt
void $ runDecls stmt
return Nothing
+ pf = initParserOpts df
#if !MIN_VERSION_ghc(9,0,0)
- pf = df
unhelpfulReason = "<interactive>"
#else
- pf = mkParserFlags df
unhelpfulReason = UnhelpfulInteractive
#endif
exec stmt l =
@@ -766,7 +722,7 @@ doKindCmd True df arg = do
doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)
doTypeCmd dflags arg = do
let (emod, expr) = parseExprMode arg
- ty <- exprType emod $ T.unpack expr
+ ty <- GHC.exprType emod $ T.unpack expr
let rawType = T.strip $ T.pack $ showSDoc dflags $ pprTypeForUser ty
broken = T.any (\c -> c == '\r' || c == '\n') rawType
pure $
@@ -812,29 +768,20 @@ parseGhciLikeCmd input = do
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike env dflags = do
- let dflags3 =
- dflags
- { hscTarget = HscInterpreted
- , ghcMode = CompManager
- , ghcLink = LinkInMemory
- }
+ let dflags3 = setInterpreterLinkerOptions dflags
platform = targetPlatform dflags3
-#if MIN_VERSION_ghc(9,0,0)
- evalWays = hostFullWays
-#else
- evalWays = interpWays
-#endif
- dflags3a = dflags3{ways = evalWays}
+ evalWays = Compat.hostFullWays
+ dflags3a = setWays evalWays dflags3
dflags3b =
foldl gopt_set dflags3a $
- concatMap (wayGeneralFlags platform) evalWays
+ concatMap (Compat.wayGeneralFlags platform) evalWays
dflags3c =
foldl gopt_unset dflags3b $
- concatMap (wayUnsetGeneralFlags platform) evalWays
+ concatMap (Compat.wayUnsetGeneralFlags platform) evalWays
dflags4 =
dflags3c
`gopt_set` Opt_ImplicitImportQualified
`gopt_set` Opt_IgnoreOptimChanges
`gopt_set` Opt_IgnoreHpcChanges
`gopt_unset` Opt_DiagnosticsShowCaret
- initializePlugins env dflags4
+ Compat.hsc_dflags <$> Compat.initializePlugins (Compat.hscSetFlags dflags4 env)
diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs
index ae3c26150c99e5eee9a1e568c0bf7e426ad20913..e5232759cec665b554a5a51f0090e0853ed75ab2 100644
--- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs
+++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs
@@ -13,22 +13,15 @@ module Ide.Plugin.Eval.GHC (
showDynFlags,
) where
-import Data.List (isPrefixOf)
-import Data.Maybe (mapMaybe)
-import Data.String (fromString)
+import Data.List (isPrefixOf)
+import Data.Maybe (mapMaybe)
+import Data.String (fromString)
import Development.IDE.GHC.Compat
-import qualified EnumSet
-import GHC.LanguageExtensions.Type (Extension (..))
-import GhcMonad (modifySession)
-import GhcPlugins (fsLit, hsc_IC, pprHsString)
-import HscTypes (InteractiveContext (ic_dflags))
-import Ide.Plugin.Eval.Util (asS, gStrictTry)
-import qualified Lexer
-import Outputable (Outputable (ppr), SDoc,
- showSDocUnsafe, text, vcat, (<+>))
-import qualified Parser
-import SrcLoc (mkRealSrcLoc)
-import StringBuffer (stringToStringBuffer)
+import Development.IDE.GHC.Compat.Util
+import qualified Development.IDE.GHC.Compat.Util as EnumSet
+
+import GHC.LanguageExtensions.Type (Extension (..))
+import Ide.Plugin.Eval.Util (asS, gStrictTry)
{- $setup
>>> import GHC
@@ -72,9 +65,9 @@ pkgNames_ :: [PackageFlag] -> [String]
pkgNames_ =
mapMaybe
( \case
- ExposePackage _ (PackageArg n) _ -> Just n
- ExposePackage _ (UnitIdArg (DefiniteUnitId n)) _ -> Just $ asS n
- _ -> Nothing
+ ExposePackage _ (PackageArg n) _ -> Just n
+ ExposePackage _ (UnitIdArg uid) _ -> Just $ asS uid
+ _ -> Nothing
)
{- | Expose a list of packages.
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 1c0a6822d0105e05731bcf329dbdb57554a13db7..a249aa1214dabcd7acf5d1a967f8a1029a4e30d7 100644
--- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs
+++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs
@@ -15,30 +15,30 @@ module Ide.Plugin.Eval.Util (
logWith,
) where
-import Control.Monad.Extra (maybeM)
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
-import Data.Aeson (Value (Null))
-import Data.Bifunctor (first)
-import Data.String (IsString (fromString))
-import qualified Data.Text as T
-import Development.IDE (IdeState, Priority (..), ideLogger,
- logPriority)
-import Development.IDE.GHC.Compat (gcatch)
-import Exception (ExceptionMonad, SomeException (..),
- evaluate)
-import GHC.Exts (toList)
-import GHC.Stack (HasCallStack, callStack,
- srcLocFile, srcLocStartCol,
- srcLocStartLine)
+import Control.Exception (SomeException, evaluate)
+import Control.Monad.Extra (maybeM)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT,
+ throwE)
+import Data.Aeson (Value (Null))
+import Data.Bifunctor (first)
+import Data.String (IsString (fromString))
+import qualified Data.Text as T
+import Development.IDE (IdeState, Priority (..),
+ ideLogger, logPriority)
+import Development.IDE.GHC.Compat (Outputable, ppr,
+ showSDocUnsafe)
+import Development.IDE.GHC.Compat.Util (MonadCatch, catch)
+import GHC.Exts (toList)
+import GHC.Stack (HasCallStack, callStack,
+ srcLocFile, srcLocStartCol,
+ srcLocStartLine)
import Language.LSP.Server
import Language.LSP.Types
-import Outputable (Outputable (ppr), ppr,
- showSDocUnsafe)
-import System.FilePath (takeExtension)
-import System.Time.Extra (duration, showDuration)
-import UnliftIO.Exception (catchAny)
+import System.FilePath (takeExtension)
+import System.Time.Extra (duration, showDuration)
+import UnliftIO.Exception (catchAny)
asS :: Outputable a => a -> String
asS = showSDocUnsafe . ppr
@@ -93,9 +93,9 @@ response' act = do
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing a) (\_ -> pure ())
return $ Right Null
-gStrictTry :: ExceptionMonad m => m b -> m (Either String b)
+gStrictTry :: (MonadIO m, MonadCatch m) => m b -> m (Either String b)
gStrictTry op =
- gcatch
+ catch
(op >>= fmap Right . gevaluate)
showErr
diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal
index 276c8b567d7b4502afe202e9e11677d970a87548..f4b8fd064137779bbfbc53f19f57bd6c39f04fe5 100644
--- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal
+++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal
@@ -28,22 +28,6 @@ library
, text
, unordered-containers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
default-language: Haskell2010
default-extensions:
DataKinds
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 4194a79e274cad137005a2d50533936dffde2aa7..d094c197d0212b1106d459f6b9a737d8bf155288 100644
--- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs
+++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs
@@ -35,16 +35,6 @@ import Ide.PluginUtils (mkLspCommand)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
-#if MIN_VERSION_ghc(9,0,0)
-import GHC.Builtin.Names (pRELUDE)
-#else
-import PrelNames (pRELUDE)
-#endif
-import RnNames (findImportUsage,
- getMinimalImports)
-import qualified SrcLoc
-import TcRnMonad (initTcWithGbl)
-import TcRnTypes (TcGblEnv (tcg_used_gres))
importCommandId :: CommandId
importCommandId = "ImportLensCommand"
@@ -197,13 +187,13 @@ minimalImportsRule = define $ \MinimalImports nfp -> do
(imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr
let importsMap =
Map.fromList
- [ (SrcLoc.realSrcSpanStart l, T.pack (prettyPrint i))
- | L (OldRealSrcSpan l) i <- fromMaybe [] mbMinImports
+ [ (realSrcSpanStart l, T.pack (prettyPrint i))
+ | L (RealSrcSpan l _) i <- fromMaybe [] mbMinImports
]
res =
- [ (i, Map.lookup (SrcLoc.realSrcSpanStart l) importsMap)
+ [ (i, Map.lookup (realSrcSpanStart l) importsMap)
| i <- imports
- , OldRealSrcSpan l <- [getLoc i]
+ , RealSrcSpan l _ <- [getLoc i]
]
return ([], MinimalImportsResult res <$ mbMinImports)
@@ -240,7 +230,7 @@ mkExplicitEdit pred posMapping (L src imp) explicit
| ImportDecl {ideclHiding = Just (False, _)} <- imp =
Nothing
| not (isQualifiedImport imp),
- OldRealSrcSpan l <- src,
+ RealSrcSpan l _ <- src,
L _ mn <- ideclName imp,
-- (almost) no one wants to see an explicit import list for Prelude
pred mn,
diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs
index 5b443dfd9b24ddf4da71929235ef80c106c4c3f5..b65405a802219c37b8f0871d65b50fa266189285 100644
--- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs
+++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs
@@ -14,9 +14,8 @@ import Control.Monad.IO.Class
import Data.Bifunctor (first)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
-import Development.IDE.GHC.Compat (moduleNameString)
-import qualified DynFlags as D
-import qualified EnumSet as S
+import Development.IDE.GHC.Compat as Compat hiding (Cpp)
+import qualified Development.IDE.GHC.Compat.Util as S
import GHC.LanguageExtensions.Type (Extension (Cpp))
import GhcPlugins (HscEnv (hsc_dflags))
import Ide.PluginUtils (makeDiffTextEdit)
@@ -88,12 +87,12 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable
FormatRange (Range (Position sl _) (Position el _)) ->
RegionIndices (Just $ sl + 1) (Just $ el + 1)
-convertDynFlags :: D.DynFlags -> IO [DynOption]
+convertDynFlags :: DynFlags -> IO [DynOption]
convertDynFlags df =
let pp = ["-pgmF=" <> p | not (null p)]
- p = D.sPgm_F $ D.settings df
- pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
- ex = map showExtension $ S.toList $ D.extensionFlags df
+ p = sPgm_F $ Compat.settings df
+ pm = map (("-fplugin=" <>) . moduleNameString) $ pluginModNames df
+ ex = map showExtension $ S.toList $ extensionFlags df
showExtension = \case
Cpp -> "-XCPP"
x -> "-X" ++ show x
diff --git a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs
index 554dea08366094751bdea7461de933ff9e8734e9..fa32279b3e05bc62f3571940df7059142438e57f 100644
--- a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs
+++ b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs
@@ -91,7 +91,9 @@ genForSig = GenComments {..}
isFresh Ann {annsDP} = null [() | (AnnComment _, _) <- annsDP]
collectKeys = keyFromTyVar 0
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+ comment = mkComment "-- ^ " (spanAsAnchor noSrcSpan)
+#elif MIN_VERSION_ghc(9,0,0)
comment = mkComment "-- ^ " badRealSrcSpan
#else
comment = mkComment "-- ^ " noSrcSpan
@@ -114,7 +116,9 @@ genForRecord = GenComments {..}
collectKeys = keyFromCon
-#if MIN_VERSION_ghc(9,0,0)
+#if MIN_VERSION_ghc(9,2,0)
+ comment = mkComment "-- | " (spanAsAnchor noSrcSpan)
+#elif MIN_VERSION_ghc(9,0,0)
comment = mkComment "-- | " badRealSrcSpan
#else
comment = mkComment "-- | " noSrcSpan
@@ -140,7 +144,7 @@ toAction title uri edit = CodeAction {..}
toRange :: SrcSpan -> Maybe Range
toRange src
- | (OldRealSrcSpan s) <- src,
+ | (RealSrcSpan s _) <- src,
range' <- realSrcSpanToRange s =
Just range'
| otherwise = Nothing
diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index 9c775c846e5d6f2c6982fe16d89e8cd002fc2993..182f5700c370ec95a6c045cfbb8c40e67530b2c9 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -9,7 +9,9 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
#ifdef HLINT_ON_GHC_LIB
@@ -51,15 +53,18 @@ import Refact.Apply
#ifdef HLINT_ON_GHC_LIB
import Data.List (nub)
-import "ghc" DynFlags as RealGHC.DynFlags (topDir)
-import qualified "ghc" EnumSet as EnumSet
-import "ghc" GHC as RealGHC (DynFlags (..))
+import Development.IDE.GHC.Compat.Core (BufSpan,
+ DynFlags,
+ extensionFlags,
+ ms_hspp_opts,
+ topDir)
+import qualified Development.IDE.GHC.Compat.Util as EnumSet
import "ghc-lib" GHC hiding
(DynFlags (..),
+ RealSrcSpan,
ms_hspp_opts)
+import qualified "ghc-lib" GHC
import "ghc-lib-parser" GHC.LanguageExtensions (Extension)
-import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags,
- ms_hspp_opts)
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension)
import System.FilePath (takeFileName)
import System.IO (IOMode (WriteMode),
@@ -72,9 +77,8 @@ import System.IO (IOMode (Wri
withFile)
import System.IO.Temp
#else
-import Development.IDE.GHC.Compat hiding
- (DynFlags (..),
- OldRealSrcSpan)
+import Development.IDE.GHC.Compat.Core hiding
+ (setEnv)
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..))
@@ -105,14 +109,16 @@ import System.Environment (setEnv,
unsetEnv)
-- ---------------------------------------------------------------------
+#ifdef HLINT_ON_GHC_LIB
-- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib
-pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan
-#if MIN_GHC_API_VERSION(9,0,0)
-pattern OldRealSrcSpan span <- RealSrcSpan span _
+pattern RealSrcSpan :: GHC.RealSrcSpan -> Maybe BufSpan -> GHC.SrcSpan
+#if MIN_VERSION_ghc(9,0,0)
+pattern RealSrcSpan x y = GHC.RealSrcSpan x y
#else
-pattern OldRealSrcSpan span <- RealSrcSpan span
+pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y))
+#endif
+{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
#endif
-{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-}
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
@@ -209,7 +215,7 @@ rules plugin = do
-- This one is defined in Development.IDE.GHC.Error but here
-- the types could come from ghc-lib or ghc
srcSpanToRange :: SrcSpan -> LSP.Range
- srcSpanToRange (OldRealSrcSpan span) = Range {
+ srcSpanToRange (RealSrcSpan span _) = Range {
_start = LSP.Position {
_line = srcSpanStartLine span - 1
, _character = srcSpanStartCol span - 1}
@@ -482,7 +488,7 @@ applyHint ide nfp mhint =
ideaPos = (srcSpanStartLine &&& srcSpanStartCol) . toRealSrcSpan . ideaSpan
in filter (\i -> ideaHint i == title' && ideaPos i == (l+1, c+1)) ideas
- toRealSrcSpan (OldRealSrcSpan real) = real
+ toRealSrcSpan (RealSrcSpan real _) = real
toRealSrcSpan (UnhelpfulSpan x) = error $ "No real source span: " ++ show x
showParseError :: Hlint.ParseError -> String
diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs
index 48bf577fbf2ce7c79fab6254428786f5a1544ba7..9635538101e59936b11c101aacb8bea4df23da1e 100644
--- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs
+++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs
@@ -32,7 +32,7 @@ import Development.IDE (GetParsedModule (GetParsedModule),
uriToFilePath', use, use_)
import Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags,
hsmodName, importPaths,
- pattern OldRealSrcSpan,
+ pattern RealSrcSpan,
pm_parsed_source, unLoc)
import Ide.Types
import Language.LSP.Server
@@ -132,7 +132,7 @@ pathModuleName state normFilePath filePath
codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text))
codeModuleName state nfp = runMaybeT $ do
pm <- MaybeT . runAction "ModuleName.GetParsedModule" state $ use GetParsedModule nfp
- L (OldRealSrcSpan l) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm
+ L (RealSrcSpan l _) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm
pure (realSrcSpanToRange l, T.pack $ show m)
-- traceAs :: Show a => String -> a -> a
diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal
index 89cd715fab7e6033dd217c7cd65f436364623abd..c1f03546c136993bb5159aa23279c98b6eae5a01 100644
--- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal
+++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal
@@ -33,22 +33,6 @@ library
default-language: Haskell2010
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
test-suite tests
type: exitcode-stdio-1.0
default-language: Haskell2010
diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs
index 4a19566f877b780c8a96013eed57e251cf5b1311..d1a465eb64c724eea87f5ec2e8ef16a267b29926 100644
--- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs
+++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs
@@ -7,21 +7,20 @@ module Ide.Plugin.Ormolu
)
where
-import Control.Exception (try)
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Text as T
-import Development.IDE hiding (pluginHandlers)
-import Development.IDE.GHC.Compat (moduleNameString)
-import qualified DynFlags as D
-import qualified EnumSet as S
+import Control.Exception (try)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T
+import Development.IDE hiding (pluginHandlers)
+import Development.IDE.GHC.Compat (moduleNameString, hsc_dflags)
+import qualified Development.IDE.GHC.Compat as D
+import qualified Development.IDE.GHC.Compat.Util as S
import GHC.LanguageExtensions.Type
-import GhcPlugins (HscEnv (hsc_dflags))
import Ide.PluginUtils
import Ide.Types
-import Language.LSP.Server hiding (defaultConfig)
+import Language.LSP.Server hiding (defaultConfig)
import Language.LSP.Types
import Ormolu
-import System.FilePath (takeFileName)
+import System.FilePath (takeFileName)
-- ---------------------------------------------------------------------
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 283f569fdb9a5c342adfbdd4b0f2a3d374cef852..c91b61634f2580a0f3177f2f3f9ee9dd354a3e20 100644
--- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs
+++ b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs
@@ -9,9 +9,6 @@
module Ide.Plugin.RefineImports (descriptor) where
-import Avail (AvailInfo (Avail),
- availName, availNames,
- availNamesWithSelectors)
import Control.Arrow (Arrow (second))
import Control.DeepSeq (rwhnf)
import Control.Monad (join)
@@ -27,7 +24,8 @@ import qualified Data.Text as T
import Data.Traversable (forM)
import Development.IDE
import Development.IDE.Core.PositionMapping
-import Development.IDE.GHC.Compat (AvailInfo,
+import Development.IDE.GHC.Compat
+ {- (AvailInfo,
GenLocated (L), GhcRn,
HsModule (hsmodImports),
ImportDecl (ImportDecl, ideclHiding, ideclName),
@@ -35,9 +33,10 @@ import Development.IDE.GHC.Compat (AvailInfo,
Module (moduleName),
ModuleName,
ParsedModule (ParsedModule, pm_parsed_source),
- SrcSpan (RealSrcSpan),
+ SrcSpan(..),
+ RealSrcSpan(..),
getLoc, ieName, noLoc,
- tcg_exports, unLoc)
+ tcg_exports, unLoc) -}
import Development.IDE.Graph.Classes
import GHC.Generics (Generic)
import Ide.Plugin.ExplicitImports (extractMinimalImports,
@@ -46,12 +45,6 @@ import Ide.PluginUtils (mkLspCommand)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
-import PrelNames (pRELUDE)
-import RnNames (findImportUsage,
- getMinimalImports)
-import TcRnMonad (initTcWithGbl,
- tcg_rn_exports,
- tcg_used_gres)
-- | plugin declaration
descriptor :: PluginId -> PluginDescriptor IdeState
@@ -257,7 +250,7 @@ refineImportsRule = define $ \RefineImports nfp -> do
mkExplicitEdit :: PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit
mkExplicitEdit posMapping (L src imp) explicit
- | RealSrcSpan l <- src,
+ | RealSrcSpan l _ <- src,
L _ mn <- ideclName imp,
-- (almost) no one wants to see an refine import list for Prelude
mn /= moduleName pRELUDE,
diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
index dca7a6634677c16ec6a0ef4fbf0d7d7f1b92843f..dee36366cd2423e8da924665ea10e6613b0ce914 100644
--- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
+++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs
@@ -125,7 +125,7 @@ refsAtName state nfp name = do
True
(nameOccName name)
(Just $ moduleName mod)
- (Just $ moduleUnitId mod)
+ (Just $ moduleUnit mod)
[fromNormalizedFilePath nfp]
pure $ nubOrd $ astRefs ++ dbRefs
diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal
index 277cb904f01dc81ca26971c568b9c3082159d98d..411429f7e2ac2bb2cc689a8ea22e9c8631f73acc 100644
--- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal
+++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal
@@ -34,22 +34,6 @@ library
, transformers
, unordered-containers
- if impl(ghc < 8.10.5)
- build-depends:
- ghc-api-compat ==8.6
- elif impl(ghc == 8.10.5)
- build-depends:
- ghc-api-compat ==8.10.5
- elif impl(ghc == 8.10.6)
- build-depends:
- ghc-api-compat ==8.10.6
- elif impl(ghc == 8.10.7)
- build-depends:
- ghc-api-compat ==8.10.7
- elif impl(ghc == 9.0.1)
- build-depends:
- ghc-api-compat ==9.0.1
-
default-language: Haskell2010
default-extensions:
DataKinds
diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
index cf41005407061d7aab2d1e5733770b147235b982..577196406703fbcf0be9401fd075d8affca1ecf6 100644
--- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
+++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs
@@ -57,28 +57,30 @@ import Development.IDE.GHC.Compat (GenLocated (L), GhcRn,
HscEnv, IdP, LRuleDecls,
ModSummary (ModSummary, ms_hspp_buf, ms_mod),
NHsValBindsLR (..),
+ Outputable,
ParsedModule (..),
RuleDecl (HsRule),
RuleDecls (HsRules),
+ SourceText (..),
SrcSpan (..),
TyClDecl (SynDecl),
TyClGroup (..), fun_id,
+ hm_iface, isQual,
+ isQual_maybe,
mi_fixities,
moduleNameString,
+ nameModule_maybe,
+ nameRdrName, occNameFS,
+ occNameString,
parseModule,
pattern IsBoot,
pattern NotBoot,
- pattern OldRealSrcSpan,
- rds_rules, srcSpanFile)
+ pattern RealSrcSpan,
+ rdrNameOcc, rds_rules,
+ srcSpanFile)
+import Development.IDE.GHC.Compat.Util hiding (catch, try)
+import qualified GHC (parseModule)
import GHC.Generics (Generic)
-import GhcPlugins (Outputable,
- SourceText (NoSourceText),
- hm_iface, isQual,
- isQual_maybe,
- nameModule_maybe,
- nameRdrName, occNameFS,
- occNameString,
- rdrNameOcc, unpackFS)
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Server (LspM,
@@ -106,7 +108,6 @@ import Retrie.Replace (Change (..),
import Retrie.Rewrites
import Retrie.SYB (listify)
import Retrie.Util (Verbosity (Loud))
-import StringBuffer (stringToStringBuffer)
import System.Directory (makeAbsolute)
descriptor :: PluginId -> PluginDescriptor IdeState
@@ -374,7 +375,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do
}
logPriority (ideLogger state) Info $ T.pack $ "Parsing module: " <> t
parsed <-
- evalGhcEnv session (parseModule ms')
+ evalGhcEnv session (GHC.parseModule ms')
`catch` \e -> throwIO (GHCParseError nt (show @SomeException e))
(fixities, parsed) <- fixFixities f (fixAnns parsed)
return (fixities, parsed)
@@ -473,7 +474,7 @@ asTextEdits NoChange = []
asTextEdits (Change reps _imports) =
[ (filePathToUri spanLoc, edit)
| Replacement {..} <- nubOrdOn (realSpan . replLocation) reps,
- (OldRealSrcSpan rspan) <- [replLocation],
+ (RealSrcSpan rspan _) <- [replLocation],
let spanLoc = unpackFS $ srcSpanFile rspan,
let edit = TextEdit (realSrcSpanToRange rspan) (T.pack replReplacement)
]
diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
index 885b8ac72e64d07fcdb77a2acb6253d7730e00a8..4e51e59b6986d63af1488aeb877cbf6d30e72f11 100644
--- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
+++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
@@ -23,6 +23,7 @@ where
import Control.Applicative (Alternative ((<|>)))
import Control.Arrow
+import Control.Exception
import qualified Control.Foldl as L
import Control.Lens (Identity (..), ix, view, (%~),
(<&>), (^.))
@@ -43,12 +44,10 @@ import Data.Maybe (fromMaybe, listToMaybe,
mapMaybe)
import qualified Data.Text as T
import Development.IDE
-import Development.IDE.GHC.Compat hiding (getLoc)
+import Development.IDE.GHC.Compat as Compat hiding (getLoc)
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.ExactPrint
-import Exception
import GHC.Exts
-import GhcMonad
-import GhcPlugins hiding (Var, getLoc, (<>))
import Ide.Plugin.Splice.Types
import Ide.Types
import Language.Haskell.GHC.ExactPrint (setPrecedingLines,
@@ -57,8 +56,6 @@ import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Capabilities
import qualified Language.LSP.Types.Lens as J
-import RnSplice
-import TcRnMonad
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
@@ -146,7 +143,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do
dflags
clientCapabilities
uri
- (graft (RealSrcSpan spliceSpan) expanded)
+ (graft (RealSrcSpan spliceSpan Nothing) expanded)
ps
maybe (throwE "No splice information found") (either throwE pure) $
case spliceContext of
@@ -162,7 +159,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do
dflags
clientCapabilities
uri
- (graftDecls (RealSrcSpan spliceSpan) expanded)
+ (graftDecls (RealSrcSpan spliceSpan Nothing) expanded)
ps
<&>
-- FIXME: Why ghc-exactprint sweeps preceeding comments?
@@ -195,7 +192,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do
where
range = realSrcSpanToRange spliceSpan
- srcSpan = RealSrcSpan spliceSpan
+ srcSpan = RealSrcSpan spliceSpan Nothing
setupHscEnv
@@ -211,33 +208,27 @@ setupHscEnv ideState fp pm = do
let ps = annotateParsedSource pm
hscEnv0 = hscEnvWithImportPaths hscEnvEq
modSum = pm_mod_summary pm
- df' <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum
- let hscEnv = hscEnv0 { hsc_dflags = df' }
- pure (ps, hscEnv, df')
+ hscEnv <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum
+ pure (ps, hscEnv, hsc_dflags hscEnv)
-setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
+setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv
setupDynFlagsForGHCiLike env dflags = do
- let dflags3 =
- dflags
- { hscTarget = HscInterpreted
- , ghcMode = CompManager
- , ghcLink = LinkInMemory
- }
+ let dflags3 = setInterpreterLinkerOptions dflags
platform = targetPlatform dflags3
- dflags3a = updateWays $ dflags3 {ways = interpWays}
+ dflags3a = setWays hostFullWays dflags3
dflags3b =
foldl gopt_set dflags3a $
- concatMap (wayGeneralFlags platform) interpWays
+ concatMap (wayGeneralFlags platform) hostFullWays
dflags3c =
foldl gopt_unset dflags3b $
- concatMap (wayUnsetGeneralFlags platform) interpWays
+ concatMap (wayUnsetGeneralFlags platform) hostFullWays
dflags4 =
dflags3c
`gopt_set` Opt_ImplicitImportQualified
`gopt_set` Opt_IgnoreOptimChanges
`gopt_set` Opt_IgnoreHpcChanges
`gopt_unset` Opt_DiagnosticsShowCaret
- initializePlugins env dflags4
+ initializePlugins (hscSetFlags dflags4 env)
adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit
adjustToRange uri ran (WorkspaceEdit mhult mlt x) =
@@ -335,26 +326,26 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
case classifyAST spliceContext of
IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $
flip (transformM dflags clientCapabilities uri) ps $
- graftDeclsWithM (RealSrcSpan srcSpan) $ \case
+ graftDeclsWithM (RealSrcSpan srcSpan Nothing) $ \case
(L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do
eExpr <-
eitherM (fail . show) pure
$ lift
( lift $
- gtry @_ @SomeException $
+ Util.try @_ @SomeException $
(fst <$> rnTopSpliceDecls spl)
)
pure $ Just eExpr
_ -> pure Nothing
OneToOneAST astP ->
flip (transformM dflags clientCapabilities uri) ps $
- graftWithM (RealSrcSpan srcSpan) $ \case
+ graftWithM (RealSrcSpan srcSpan Nothing) $ \case
(L _spn (matchSplice astP -> Just spl)) -> do
eExpr <-
eitherM (fail . show) pure
$ lift
( lift $
- gtry @_ @SomeException $
+ Util.try @_ @SomeException $
(fst <$> expandSplice astP spl)
)
Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr
@@ -428,8 +419,8 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
mkQ
Continue
( \case
- (L l@(RealSrcSpan spLoc) expr :: LHsExpr GhcPs)
- | RealSrcSpan spn `isSubspanOf` l ->
+ (L l@(RealSrcSpan spLoc _) expr :: LHsExpr GhcPs)
+ | RealSrcSpan spn Nothing `isSubspanOf` l ->
case expr of
HsSpliceE {} -> Here (spLoc, Expr)
_ -> Continue
@@ -437,25 +428,25 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
)
`extQ` \case
#if __GLASGOW_HASKELL__ == 808
- (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc) pat :: Located (Pat GhcPs))
+ (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs))
#else
- (L l@(RealSrcSpan spLoc) pat :: LPat GhcPs)
+ (L l@(RealSrcSpan spLoc _) pat :: LPat GhcPs)
#endif
- | RealSrcSpan spn `isSubspanOf` l ->
+ | RealSrcSpan spn Nothing `isSubspanOf` l ->
case pat of
SplicePat{} -> Here (spLoc, Pat)
_ -> Continue
_ -> Stop
`extQ` \case
- (L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs)
- | RealSrcSpan spn `isSubspanOf` l ->
+ (L l@(RealSrcSpan spLoc _) ty :: LHsType GhcPs)
+ | RealSrcSpan spn Nothing `isSubspanOf` l ->
case ty of
HsSpliceTy {} -> Here (spLoc, HsType)
_ -> Continue
_ -> Stop
`extQ` \case
- (L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs)
- | RealSrcSpan spn `isSubspanOf` l ->
+ (L l@(RealSrcSpan spLoc _) decl :: LHsDecl GhcPs)
+ | RealSrcSpan spn Nothing `isSubspanOf` l ->
case decl of
SpliceD {} -> Here (spLoc, HsDecl)
_ -> Continue
diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs
index 9082c2b634677edea404b6f8921b69e73d5baf87..071341b36bad2038774186ef36a4524f47cf4ecc 100644
--- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs
+++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs
@@ -9,9 +9,8 @@ import Control.Monad.IO.Class
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
-import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts))
-import qualified DynFlags as D
-import qualified EnumSet as ES
+import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), extensionFlags)
+import qualified Development.IDE.GHC.Compat.Util as Util
import GHC.LanguageExtensions.Type
import Ide.PluginUtils
import Ide.Types
@@ -52,7 +51,7 @@ provider ide typ contents fp _opts = do
| otherwise
= pure config
- getExtensions = map showExtension . ES.toList . D.extensionFlags
+ getExtensions = map showExtension . Util.toList . extensionFlags
showExtension Cpp = "CPP"
showExtension other = show other
diff --git a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs
index 89769ae8aa8db711de1f5ddc2f611f9d718ce1f8..c993f60a6ccc714d9b7ba949adb804935cf162b0 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs
@@ -16,8 +16,6 @@ import Development.IDE.Core.UseStale
import Development.IDE.GHC.Compat
import Development.IDE.GHC.ExactPrint
import Generics.SYB.GHC (mkBindListT, everywhereM')
-import GhcPlugins (occName)
-import System.Timeout (timeout)
import Wingman.AbstractLSP.Types
import Wingman.CaseSplit
import Wingman.GHC (liftMaybe, isHole, pattern AMatch, unXPat)
@@ -76,7 +74,7 @@ makeTacticInteraction cmd =
$ addTimeoutMessage rtr
$ pure
$ GraftEdit
- $ graftHole (RealSrcSpan $ unTrack pm_span) rtr
+ $ graftHole (RealSrcSpan (unTrack pm_span) Nothing) rtr
addTimeoutMessage :: RunTacticResults -> [ContinuationResult] -> [ContinuationResult]
diff --git a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs
index e93af82e50af8d707ecf4740b36e495f1048c124..180229cf0287d5504a418712bda684ad4a5a32d0 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs
@@ -12,7 +12,6 @@ import qualified Data.Set as S
import Development.IDE.GHC.Compat
import GHC.Exts (IsString (fromString))
import GHC.SourceGen (funBindsWithFixity, match, wildP)
-import OccName
import Wingman.GHC
import Wingman.Types
diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs
index 07b112e01ac27baad87d79f2c86fad5465cc6f10..5f2f86605cb0c01f1f8678b58ce73d01c1b2c6ab 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs
@@ -10,7 +10,6 @@ module Wingman.CodeGen
) where
-import ConLike
import Control.Lens ((%~), (<>~), (&))
import Control.Monad.Except
import Control.Monad.Reader (ask)
@@ -22,7 +21,6 @@ import Data.Generics.Labels ()
import Data.List
import qualified Data.Set as S
import Data.Traversable
-import DataCon
import Development.IDE.GHC.Compat
import GHC.Exts
import GHC.SourceGen (occNameToStr)
@@ -30,11 +28,6 @@ import GHC.SourceGen.Binds
import GHC.SourceGen.Expr
import GHC.SourceGen.Overloaded
import GHC.SourceGen.Pat
-import GhcPlugins (isSymOcc, mkVarOccFS)
-import OccName (occName)
-import PatSyn
-import Type hiding (Var)
-import TysPrim (alphaTy)
import Wingman.CodeGen.Utils
import Wingman.GHC
import Wingman.Judgements
@@ -202,7 +195,7 @@ conLikeInstOrigArgTys' con uniTys =
conLikeExTys :: ConLike -> [TyCoVar]
-conLikeExTys (RealDataCon d) = dataConExTys d
+conLikeExTys (RealDataCon d) = dataConExTyCoVars d
conLikeExTys (PatSynCon p) = patSynExTys p
patSynExTys :: PatSyn -> [TyCoVar]
diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs
index 1f1738dacc7a89532dbe53b9e973e67102d4ad2f..d683db9ffd9cf12e3c2be9f9f28f6ad466a2e214 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs
@@ -1,14 +1,10 @@
module Wingman.CodeGen.Utils where
-import ConLike (ConLike(RealDataCon), conLikeName)
+import Data.String
import Data.List
-import DataCon
import Development.IDE.GHC.Compat
-import GHC.Exts
import GHC.SourceGen (RdrNameStr (UnqualStr), recordConE, string)
-import GHC.SourceGen.Overloaded
-import GhcPlugins (nilDataCon, charTy, eqType)
-import Name
+import GHC.SourceGen.Overloaded as SourceGen
import Wingman.GHC (getRecordFields)
@@ -48,7 +44,7 @@ coerceName = UnqualStr . fromString . occNameString . occName
------------------------------------------------------------------------------
-- | Like 'var', but works over standard GHC 'OccName's.
-var' :: Var a => OccName -> a
+var' :: SourceGen.Var a => OccName -> a
var' = var . fromString . occNameString
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Context.hs b/plugins/hls-tactics-plugin/src/Wingman/Context.hs
index 0cfd6488d64627307a9a311a537a1ff6a3875714..9aea0bf5eba8930a340558c290b4ef826dda1e60 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Context.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Context.hs
@@ -1,6 +1,5 @@
module Wingman.Context where
-import Bag
import Control.Arrow
import Control.Monad.Reader
import Data.Coerce (coerce)
@@ -8,12 +7,7 @@ import Data.Foldable.Extra (allM)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import qualified Data.Set as S
import Development.IDE.GHC.Compat
-import GhcPlugins (ExternalPackageState (eps_inst_env), piResultTys, eps_fam_inst_env, extractModule)
-import InstEnv (lookupInstEnv, InstEnvs(..), is_dfun)
-import OccName
-import TcRnTypes
-import TcType (tcSplitTyConApp, tcSplitPhiTy)
-import TysPrim (alphaTys)
+import Development.IDE.GHC.Compat.Util
import Wingman.GHC (normalizeType)
import Wingman.Judgements.Theta
import Wingman.Types
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs
index 7db728b9ab2b5522548b858a2127252a6eafc4b9..1c5e0f55177539199c6f188ac78e538bd620d1d6 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs
@@ -17,19 +17,9 @@ module Wingman.Debug
import Control.DeepSeq
import Control.Exception
import Debug.Trace
-import DynFlags (unsafeGlobalDynFlags)
-import Outputable hiding ((<>))
+import Development.IDE.GHC.Compat (PlainGhcException, Outputable(..), SDoc, showSDocUnsafe)
import System.IO.Unsafe (unsafePerformIO)
-#if __GLASGOW_HASKELL__ >= 808
-import PlainPanic (PlainGhcException)
-type GHC_EXCEPTION = PlainGhcException
-#else
-import Panic (GhcException)
-type GHC_EXCEPTION = GhcException
-#endif
-
-
------------------------------------------------------------------------------
-- | Print something
unsafeRender :: Outputable a => a -> String
@@ -38,10 +28,10 @@ unsafeRender = unsafeRender' . ppr
unsafeRender' :: SDoc -> String
unsafeRender' sdoc = unsafePerformIO $ do
- let z = showSDoc unsafeGlobalDynFlags sdoc
+ let z = showSDocUnsafe sdoc
-- We might not have unsafeGlobalDynFlags (like during testing), in which
-- case GHC panics. Instead of crashing, let's just fail to print.
- !res <- try @GHC_EXCEPTION $ evaluate $ deepseq z z
+ !res <- try @PlainGhcException $ evaluate $ deepseq z z
pure $ either (const "<unsafeRender'>") id res
{-# NOINLINE unsafeRender' #-}
diff --git a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
index 93deee4e3a78001405d5922e49517d67f68cf9d5..42c62cfc193be8f5d54321788ee912f058a5547c 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
@@ -22,16 +22,13 @@ import Development.IDE (realSrcSpanToRange)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake (IdeState (..))
import Development.IDE.Core.UseStale
-import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat hiding (empty)
import Development.IDE.GHC.ExactPrint
import Development.IDE.Spans.LocalBindings (getLocalScope)
import Ide.Types
import Language.LSP.Server
import Language.LSP.Types
-import OccName
import Prelude hiding (span)
-import Prelude hiding (span)
-import TcRnTypes (tcg_binds)
import Wingman.AbstractLSP.Types
import Wingman.CodeGen (destructionFor)
import Wingman.GHC
@@ -73,7 +70,7 @@ emptyCaseInteraction = Interaction $
ty
edits <- liftMaybe $ hush $
mkWorkspaceEdits le_dflags ccs fc_uri (unTrack pm) $
- graftMatchGroup (RealSrcSpan $ unTrack ss) $
+ graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $
noLoc matches
pure
( range
@@ -153,7 +150,7 @@ emptyCaseScrutinees state nfp = do
True -> pure empty
False ->
case ss of
- RealSrcSpan r -> do
+ RealSrcSpan r _ -> do
rss' <- liftMaybe $ mapAgeTo tcg_map $ unsafeCopyAge aged r
pure $ Just (rss', ty)
UnhelpfulSpan _ -> empty
diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
index 43eb2cfa6abe0d6c49f9b97f9f67b948f36af160..647d6cd60b08e12f8e5475ce28f7d889c3f28ce8 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
@@ -3,12 +3,8 @@
module Wingman.GHC where
-import Bag (bagToList)
-import Class (classTyVars)
-import ConLike
import Control.Monad.State
import Control.Monad.Trans.Maybe (MaybeT(..))
-import CoreUtils (exprType)
import Data.Bool (bool)
import Data.Function (on)
import Data.Functor ((<&>))
@@ -18,24 +14,10 @@ import Data.Maybe (isJust)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Traversable
-import DataCon
-import Development.IDE.GHC.Compat hiding (exprType)
-import DsExpr (dsExpr)
-import DsMonad (initDs)
-import FamInst (tcLookupDataFamInst_maybe)
-import FamInstEnv (normaliseType)
+import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util
import GHC.SourceGen (lambda)
import Generics.SYB (Data, everything, everywhere, listify, mkQ, mkT)
-import GhcPlugins (Role (Nominal))
-import OccName
-import TcRnMonad
-import TcType
-import TyCoRep
-import Type
-import TysWiredIn (charTyCon, doubleTyCon, floatTyCon, intTyCon)
-import Unify
-import Unique
-import Var
import Wingman.StaticPlugin (pattern MetaprogramSyntax)
import Wingman.Types
@@ -61,8 +43,8 @@ instantiateType t = do
cloneTyVar :: TyVar -> TyVar
cloneTyVar t =
let uniq = getUnique t
- some_magic_number = 49
- in setVarUnique t $ deriveUnique uniq some_magic_number
+ some_magic_char = 'w' -- 'w' for wingman ;D
+ in setVarUnique t $ newTagUnique uniq some_magic_char
------------------------------------------------------------------------------
@@ -92,7 +74,7 @@ tacticsThetaTy (tcSplitSigmaTy -> (_, theta, _)) = theta
-- | Get the data cons of a type, if it has any.
tacticsGetDataCons :: Type -> Maybe ([DataCon], [Type])
tacticsGetDataCons ty
- | Just (_, ty') <- tcSplitForAllTy_maybe ty
+ | Just (_, ty') <- tcSplitForAllTyVarBinder_maybe ty
= tacticsGetDataCons ty'
tacticsGetDataCons ty
| Just _ <- algebraicTyCon ty
@@ -118,7 +100,7 @@ freshTyvars t = do
case M.lookup tv reps of
Just tv' -> tv'
Nothing -> tv
- ) $ snd $ tcSplitForAllTys t
+ ) $ snd $ tcSplitForAllTyVars t
------------------------------------------------------------------------------
@@ -137,7 +119,7 @@ getRecordFields dc =
-- | Is this an algebraic type?
algebraicTyCon :: Type -> Maybe TyCon
algebraicTyCon ty
- | Just (_, ty') <- tcSplitForAllTy_maybe ty
+ | Just (_, ty') <- tcSplitForAllTyVarBinder_maybe ty
= algebraicTyCon ty'
algebraicTyCon (splitTyConApp_maybe -> Just (tycon, _))
| tycon == intTyCon = Nothing
@@ -322,15 +304,6 @@ pattern TopLevelRHS name ps body where_binds <-
(GRHSs _
[L _ (GRHS _ [] body)] (L _ where_binds))
-
-dataConExTys :: DataCon -> [TyCoVar]
-#if __GLASGOW_HASKELL__ >= 808
-dataConExTys = DataCon.dataConExTyCoVars
-#else
-dataConExTys = DataCon.dataConExTyVars
-#endif
-
-
------------------------------------------------------------------------------
-- | In GHC 8.8, sometimes patterns are wrapped in 'XPat'.
-- The nitty gritty details are explained at
@@ -354,16 +327,6 @@ liftMaybe a = MaybeT $ pure a
typeCheck :: HscEnv -> TcGblEnv -> HsExpr GhcTc -> IO (Maybe Type)
typeCheck hscenv tcg = fmap snd . initDs hscenv tcg . fmap exprType . dsExpr
-
-mkFunTys' :: [Type] -> Type -> Type
-mkFunTys' =
-#if __GLASGOW_HASKELL__ <= 808
- mkFunTys
-#else
- mkVisFunTys
-#endif
-
-
------------------------------------------------------------------------------
-- | Expand type and data families
normalizeType :: Context -> Type -> Type
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs
index 21c1e609a81d930c7ac13202f8a10cee8bf0a35b..1b5a88999bca7951ca564e3c9ae6b102bd462acd 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs
@@ -1,6 +1,5 @@
module Wingman.Judgements where
-import ConLike (ConLike)
import Control.Arrow
import Control.Lens hiding (Context)
import Data.Bool
@@ -13,10 +12,8 @@ import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
import Development.IDE.Core.UseStale (Tracked, unTrack)
+import Development.IDE.GHC.Compat hiding (isTopLevel)
import Development.IDE.Spans.LocalBindings
-import OccName
-import SrcLoc
-import Type
import Wingman.GHC (algebraicTyCon, normalizeType)
import Wingman.Judgements.Theta
import Wingman.Types
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs
index 0365e5e392f42e0719b6538d0f3534b8d507543d..ba3bba437836ff7108696189808371c495f36a69 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs
@@ -8,8 +8,8 @@ import Data.Foldable (foldl')
import Data.Generics hiding (typeRep)
import qualified Data.Text as T
import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util (unpackFS)
import GHC.Exts (Any)
-import GhcPlugins (unpackFS)
import Type.Reflection
import Unsafe.Coerce (unsafeCoerce)
import Wingman.StaticPlugin (pattern WingmanMetaprogram)
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs
index 21b16edbc47df95ea680e417b2edf70896ccfcc0..c2fccd4d7d41658d80f9801cbc7d1a8b234b0d62 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs
@@ -12,7 +12,6 @@ module Wingman.Judgements.Theta
, allEvidenceToSubst
) where
-import Class (classTyVars)
import Control.Applicative (empty)
import Control.Lens (preview)
import Data.Coerce (coerce)
@@ -21,20 +20,9 @@ import Data.Generics.Sum (_Ctor)
import Data.Set (Set)
import qualified Data.Set as S
import Development.IDE.Core.UseStale
-import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat hiding (empty)
import Generics.SYB hiding (tyConName, empty, Generic)
import GHC.Generics
-import GhcPlugins (mkVarOcc, splitTyConApp_maybe, getTyVar_maybe, zipTvSubst, unionTCvSubst, emptyTCvSubst, TCvSubst)
-#if __GLASGOW_HASKELL__ > 806
-import GhcPlugins (eqTyCon)
-#else
-import GhcPlugins (nameRdrName, tyConName)
-import PrelNames (eqTyCon_RDR)
-#endif
-import TcEvidence
-import TcType (substTy)
-import TcType (tcTyConAppTyCon_maybe)
-import TysPrim (eqPrimTyCon)
import Wingman.GHC
import Wingman.Types
diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs
index 5158ce4fc816e6ffdc20a84c191f045aa0aa4db9..c5df1c80c12584ed3caafa24742ca8e62d261b46 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs
@@ -1,7 +1,7 @@
module Wingman.KnownStrategies where
import Data.Foldable (for_)
-import OccName (mkVarOcc, mkClsOcc)
+import Development.IDE.GHC.Compat.Core
import Refinery.Tactic
import Wingman.Judgements (jGoal)
import Wingman.KnownStrategies.QuickCheck (deriveArbitrary)
diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs
index f6013af5af35eb5d5e1aebb562fbc1e73e4c8833..4cc1d4afb8b9ae65649930d81a2fe7d5789fe691 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs
@@ -1,11 +1,9 @@
module Wingman.KnownStrategies.QuickCheck where
-import ConLike (ConLike(RealDataCon))
import Data.Bool (bool)
import Data.Generics (everything, mkQ)
import Data.List (partition)
-import DataCon (DataCon, dataConName)
-import Development.IDE.GHC.Compat (GhcPs, HsExpr, noLoc)
+import Development.IDE.GHC.Compat
import GHC.Exts (IsString (fromString))
import GHC.List (foldl')
import GHC.SourceGen (int)
@@ -13,10 +11,7 @@ import GHC.SourceGen.Binds (match, valBind)
import GHC.SourceGen.Expr (case', lambda, let')
import GHC.SourceGen.Overloaded (App ((@@)), HasList (list))
import GHC.SourceGen.Pat (conP)
-import OccName (HasOccName (occName), mkVarOcc, occNameString)
import Refinery.Tactic (goal, rule, failure)
-import TyCon (TyCon, tyConDataCons, tyConName)
-import Type (splitTyConApp_maybe)
import Wingman.CodeGen
import Wingman.Judgements (jGoal)
import Wingman.Machinery (tracePrim)
diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs
index 10a09bccd913c6a69f7224f7ffe0a6415182ebe0..3524194fb1f279c05d06ed38cc20279e0273caa4 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs
@@ -8,7 +8,6 @@
module Wingman.LanguageServer where
-import ConLike
import Control.Arrow ((***))
import Control.Monad
import Control.Monad.IO.Class
@@ -35,16 +34,15 @@ import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake (IdeState (..), uses, define, use)
import qualified Development.IDE.Core.Shake as IDE
import Development.IDE.Core.UseStale
-import Development.IDE.GHC.Compat hiding (parseExpr)
+import Development.IDE.GHC.Compat hiding (empty)
+import qualified Development.IDE.GHC.Compat.Util as FastString
import Development.IDE.GHC.Error (realSrcSpanToRange)
import Development.IDE.GHC.ExactPrint
import Development.IDE.Graph (Action, RuleResult, Rules, action)
import Development.IDE.Graph.Classes (Binary, Hashable, NFData)
import Development.IDE.Spans.LocalBindings (Bindings, getDefiningBindings)
-import qualified FastString
import GHC.Generics (Generic)
import Generics.SYB hiding (Generic)
-import GhcPlugins (tupleDataCon, consDataCon, substTyAddInScope, ExternalPackageState, HscEnv (hsc_EPS), unpackFS)
import qualified Ide.Plugin.Config as Plugin
import Ide.Plugin.Properties
import Ide.PluginUtils (usePropertyLsp)
@@ -57,11 +55,8 @@ import Language.LSP.Types hiding
SemanticTokenRelative (length),
SemanticTokensEdit (_start))
import Language.LSP.Types.Capabilities
-import OccName
import Prelude hiding (span)
import Retrie (transformA)
-import SrcLoc (containsSpan)
-import TcRnTypes (tcg_binds, TcGblEnv)
import Wingman.Context
import Wingman.GHC
import Wingman.Judgements
@@ -183,7 +178,7 @@ getIdeDynflags state nfp = do
getAllMetaprograms :: Data a => a -> [String]
getAllMetaprograms = everything (<>) $ mkQ mempty $ \case
- WingmanMetaprogram fs -> [ unpackFS fs ]
+ WingmanMetaprogram fs -> [ FastString.unpackFS fs ]
(_ :: HsExpr GhcTc) -> mempty
@@ -222,7 +217,7 @@ judgementForHole state nfp range cfg = do
eps <- liftIO $ readIORef $ hsc_EPS $ hscEnv henv
(jdg, ctx) <- liftMaybe $ mkJudgementAndContext cfg g binds new_rss tcg (hscEnv henv) eps
- let mp = getMetaprogramAtSpan (fmap RealSrcSpan tcg_rss) tcg_t
+ let mp = getMetaprogramAtSpan (fmap (`RealSrcSpan` Nothing) tcg_rss) tcg_t
dflags <- getIdeDynflags state nfp
pure $ HoleJudgment
@@ -261,10 +256,10 @@ mkJudgementAndContext cfg g (TrackedStale binds bmap) rss (TrackedStale tcg tcgm
eps
evidence
top_provs = getRhsPosVals tcg_rss tcs
- already_destructed = getAlreadyDestructed (fmap RealSrcSpan tcg_rss) tcs
+ already_destructed = getAlreadyDestructed (fmap (`RealSrcSpan` Nothing) tcg_rss) tcs
local_hy = spliceProvenance top_provs
$ hypothesisFromBindings binds_rss binds
- evidence = getEvidenceAtHole (fmap RealSrcSpan tcg_rss) tcs
+ evidence = getEvidenceAtHole (fmap (`RealSrcSpan` Nothing) tcg_rss) tcs
cls_hy = foldMap evidenceToHypothesis evidence
subst = ts_unifier $ evidenceToSubst evidence defaultTacticState
pure $
@@ -339,7 +334,7 @@ getRhsPosVals
getRhsPosVals (unTrack -> rss) (unTrack -> tcs)
= everything (<>) (mkQ mempty $ \case
TopLevelRHS name ps
- (L (RealSrcSpan span) -- body with no guards and a single defn
+ (L (RealSrcSpan span _) -- body with no guards and a single defn
(HsVar _ (L _ hole)))
_
| containsSpan rss span -- which contains our span
@@ -495,7 +490,7 @@ isRhsHoleWithoutWhere
isRhsHoleWithoutWhere (unTrack -> rss) (unTrack -> tcs) =
everything (||) (mkQ False $ \case
TopLevelRHS _ _
- (L (RealSrcSpan span) _)
+ (L (RealSrcSpan span _) _)
(EmptyLocalBinds _) -> containsSpan rss span
_ -> False
) tcs
diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs
index 915724f1aa433e67c436eaaba6c46f92ac7b3348..1cdee0b02dcfe80608e895b7b2fb0c8039734c57 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs
@@ -21,13 +21,10 @@ import Development.IDE (realSrcSpanToRange)
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake (IdeState (..))
import Development.IDE.Core.UseStale
-import Development.IDE.GHC.Compat
-import GhcPlugins (containsSpan, realSrcLocSpan, realSrcSpanStart)
+import Development.IDE.GHC.Compat hiding (empty)
import Ide.Types
import Language.LSP.Types
import Prelude hiding (span)
-import Prelude hiding (span)
-import TcRnTypes (tcg_binds)
import Wingman.GHC
import Wingman.Judgements.SYB (metaprogramQ)
import Wingman.LanguageServer
@@ -44,7 +41,7 @@ hoverProvider state plId (HoverParams (TextDocumentIdentifier uri) (unsafeMkCurr
cfg <- getTacticConfig plId
liftIO $ fromMaybeT (Right Nothing) $ do
- holes <- getMetaprogramsAtSpan state nfp $ RealSrcSpan $ unTrack loc
+ holes <- getMetaprogramsAtSpan state nfp $ RealSrcSpan (unTrack loc) Nothing
fmap (Right . Just) $
case (find (flip containsSpan (unTrack loc) . unTrack . fst) holes) of
@@ -80,7 +77,7 @@ getMetaprogramsAtSpan state nfp ss = do
let scrutinees = traverse (metaprogramQ ss . tcg_binds) tcg
for scrutinees $ \aged@(unTrack -> (ss, program)) -> do
case ss of
- RealSrcSpan r -> do
+ RealSrcSpan r _ -> do
rss' <- liftMaybe $ mapAgeTo tcg_map $ unsafeCopyAge aged r
pure (rss', program)
UnhelpfulSpan _ -> empty
diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs
index 5a0844b73cbf05e889e07df05c1def5abe15d5e3..631baf58b72eea5d21a9edeac31d567158cf058a 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs
@@ -16,12 +16,10 @@ import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import qualified Data.Text as T
-import DataCon (dataConName)
import Development.IDE.GHC.Compat
import GHC.LanguageExtensions.Type (Extension (LambdaCase))
import Ide.Types
import Language.LSP.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..))
-import OccName
import Prelude hiding (span)
import Wingman.AbstractLSP.Types
import Wingman.Auto
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs
index 9a369cdd0ab4e14dcb2dcf2717bb218e24527739..56fd9f7b2eee1a9818db0e30a9528a5e4fde660c 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs
@@ -24,16 +24,12 @@ import Data.Ord (Down (..), comparing)
import qualified Data.Set as S
import Data.Traversable (for)
import Development.IDE.Core.Compile (lookupName)
-import Development.IDE.GHC.Compat
-import GhcPlugins (GlobalRdrElt (gre_name), lookupOccEnv, varType)
+import Development.IDE.GHC.Compat hiding (isTopLevel, empty)
import Refinery.Future
import Refinery.ProofState
import Refinery.Tactic
import Refinery.Tactic.Internal
import System.Timeout (timeout)
-import TcType
-import Type (tyCoVarsOfTypeWellScoped)
-import TysPrim (alphaTyVar, alphaTy)
import Wingman.Context (getInstance)
import Wingman.GHC (tryUnifyUnivarsButNotSkolems, updateSubst, tacticsGetDataCons, freshTyvars)
import Wingman.Judgements
@@ -235,7 +231,7 @@ newtype Reward a = Reward a
newUnivar :: MonadState TacticState m => m Type
newUnivar = do
freshTyvars $
- mkInvForAllTys [alphaTyVar] alphaTy
+ mkInfForAllTys [alphaTyVar] alphaTy
------------------------------------------------------------------------------
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs
index 2c15cee171c2a8731426158cbada2174904164df..a9bdb694d1e55f9e8abe60fa624e83f3b16462b0 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs
@@ -11,7 +11,7 @@ import Data.Foldable (asum)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void
-import Name
+import Development.IDE.GHC.Compat.Core (OccName, mkVarOcc)
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as L
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs
index c16b9dca70201e2b5764626ebc56da175e55a50a..96c93da2d1432945f282c3d29287496eff80d9d6 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs
@@ -11,7 +11,7 @@ import Data.Functor
import Data.Maybe (listToMaybe)
import qualified Data.Text as T
import Development.IDE.GHC.Compat (RealSrcLoc, srcLocLine, srcLocCol, srcLocFile)
-import FastString (unpackFS)
+import Development.IDE.GHC.Compat.Util (unpackFS)
import Refinery.Tactic (failure)
import qualified Refinery.Tactic as R
import qualified Text.Megaparsec as P
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs
index b63dea6f086a2a9020847e7ef6deaa0dfc4a5fee..7b047513f8a66825501ca526dbf34443c951f6c3 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs
@@ -8,7 +8,7 @@ import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc hiding (parens)
import Data.Text.Prettyprint.Doc.Render.String (renderString)
-import GhcPlugins (OccName)
+import Development.IDE.GHC.Compat (OccName)
import qualified Text.Megaparsec as P
import Wingman.Metaprogramming.Lexer (Parser, identifier, variable, parens)
import Wingman.Types (TacticsM)
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
index 51416ecd21461534ec32e5baae59bb671b2ffede..05f5c2b85ac5d5903ca967bb372cdc23269fc8ca 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
@@ -14,13 +14,8 @@ import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as S
import Data.Traversable
-import GhcPlugins (charTy, maybeTyCon)
-import Name
-import TcType
+import Development.IDE.GHC.Compat.Core hiding (IsFunction)
import Text.Hyphenation (hyphenate, english_US)
-import TyCon
-import Type
-import TysWiredIn (listTyCon, unitTyCon)
import Wingman.GHC (tcTyVar_maybe)
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Range.hs b/plugins/hls-tactics-plugin/src/Wingman/Range.hs
index fed5729996ebbfb43c7da30cd60f58d0ef992755..b7ae845663dba0e4edf826f007ee2fe998f2ceae 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Range.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Range.hs
@@ -4,15 +4,16 @@
module Wingman.Range where
import Development.IDE hiding (rangeToRealSrcSpan, rangeToSrcSpan)
-import qualified FastString as FS
-import SrcLoc
+import Development.IDE.GHC.Compat.Core
+import Development.IDE.GHC.Compat.Util as FS
+
------------------------------------------------------------------------------
-- | Convert a DAML compiler Range to a GHC SrcSpan
-- TODO(sandy): this doesn't belong here
rangeToSrcSpan :: String -> Range -> SrcSpan
-rangeToSrcSpan file range = RealSrcSpan $ rangeToRealSrcSpan file range
+rangeToSrcSpan file range = RealSrcSpan (rangeToRealSrcSpan file range) Nothing
rangeToRealSrcSpan :: String -> Range -> RealSrcSpan
diff --git a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs
index 635fa463a5a413bc262c0e0db8855248e16eb68c..441c0ae3297b2d8e8e74ea8af6575b61c462ad2c 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs
@@ -9,12 +9,11 @@ module Wingman.StaticPlugin
import Data.Data
import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat.Util
import GHC.LanguageExtensions.Type (Extension(EmptyCase, QuasiQuotes))
import Generics.SYB
-import GhcPlugins hiding ((<>))
import Ide.Types
-
staticPlugin :: DynFlagsModifications
staticPlugin = mempty
{ dynFlagsModifyGlobal =
@@ -41,9 +40,15 @@ pattern MetaprogramSourceText = SourceText "wingman-meta-program"
pattern WingmanMetaprogram :: FastString -> HsExpr p
-pattern WingmanMetaprogram mp
- <- HsSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp)
+pattern WingmanMetaprogram mp <-
+#if __GLASGOW_HASKELL__ >= 900
+ HsPragE _ (HsPragSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp))
+ (L _ ( HsVar _ _))
+#else
+ HsSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp)
(L _ ( HsVar _ _))
+#endif
+
enableQuasiQuotes :: DynFlags -> DynFlags
@@ -63,7 +68,7 @@ metaprogrammingPlugin :: StaticPlugin
metaprogrammingPlugin =
StaticPlugin $ PluginWithArgs (defaultPlugin { parsedResultAction = worker }) []
where
- worker :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
+ worker :: Monad m => [CommandLineOption] -> ModSummary -> HsParsedModule -> m HsParsedModule
worker _ _ pm = pure $ pm { hpm_module = addMetaprogrammingSyntax $ hpm_module pm }
#endif
@@ -73,7 +78,11 @@ metaprogramHoleName = mkVarOcc "_$metaprogram"
mkMetaprogram :: SrcSpan -> FastString -> HsExpr GhcPs
mkMetaprogram ss mp =
+#if __GLASGOW_HASKELL__ >= 900
+ HsPragE noExtField (HsPragSCC noExtField MetaprogramSourceText (StringLiteral NoSourceText mp))
+#else
HsSCC noExtField MetaprogramSourceText (StringLiteral NoSourceText mp)
+#endif
$ L ss
$ HsVar noExtField
$ L ss
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
index 7971ca4671d14d36dd2be222b2dbd01fb21faa02..d6909a11cab9d60533974cf8a87104d432fa7b6c 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
@@ -6,7 +6,6 @@ module Wingman.Tactics
, runTactic
) where
-import ConLike (ConLike(RealDataCon))
import Control.Applicative (Alternative(empty), (<|>))
import Control.Lens ((&), (%~), (<>~))
import Control.Monad (filterM)
@@ -26,16 +25,12 @@ import Data.Set (Set)
import qualified Data.Set as S
import Data.Traversable (for)
import DataCon
-import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat hiding (empty)
import GHC.Exts
import GHC.SourceGen ((@@))
import GHC.SourceGen.Expr
-import Name (occNameString, occName)
-import OccName (mkVarOcc)
import Refinery.Tactic
import Refinery.Tactic.Internal
-import TcType
-import Type hiding (Var)
import Wingman.CodeGen
import Wingman.GHC
import Wingman.Judgements
@@ -150,7 +145,7 @@ intros' params = rule $ \jdg -> do
bound_occs = fmap fst bindings
hy' = lambdaHypothesis top_hole bindings
jdg' = introduce ctx hy'
- $ withNewGoal (CType $ mkFunTys' (drop num_occs args) res) jdg
+ $ withNewGoal (CType $ mkVisFunTys (drop num_occs args) res) jdg
ext <- newSubgoal jdg'
pure $
ext
@@ -289,7 +284,7 @@ apply (Unsaturated n) hi = tracing ("apply' " <> show (hi_name hi)) $ do
saturated_args = dropEnd n all_args
unsaturated_args = takeEnd n all_args
rule $ \jdg -> do
- unify g (CType $ mkFunTys' unsaturated_args ret)
+ unify g (CType $ mkVisFunTys unsaturated_args ret)
ext
<- fmap unzipTrace
$ traverse ( newSubgoal
@@ -545,7 +540,7 @@ nary :: Int -> TacticsM ()
nary n = do
a <- newUnivar
b <- newUnivar
- applyByType $ mkFunTys' (replicate n a) b
+ applyByType $ mkVisFunTys (replicate n a) b
self :: TacticsM ()
@@ -630,7 +625,7 @@ with_arg = rule $ \jdg -> do
let g = jGoal jdg
fresh_ty <- newUnivar
a <- newSubgoal $ withNewGoal (CType fresh_ty) jdg
- f <- newSubgoal $ withNewGoal (coerce mkFunTys' [fresh_ty] g) jdg
+ f <- newSubgoal $ withNewGoal (coerce mkVisFunTys [fresh_ty] g) jdg
pure $ fmap noLoc $ (@@) <$> fmap unLoc f <*> fmap unLoc a
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs
index 491ff9724a65b51eb5cfcb6404e24b2d75f8677e..63c30a82aed2af4c7f55a42e7c196e075f4a650b 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs
@@ -14,7 +14,6 @@ module Wingman.Types
, Span
) where
-import ConLike (ConLike)
import Control.Lens hiding (Context)
import Control.Monad.Reader
import Control.Monad.State
@@ -33,23 +32,17 @@ import Data.Tree
import Development.IDE (Range)
import Development.IDE.Core.UseStale
import Development.IDE.GHC.Compat hiding (Node)
+import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Orphans ()
-import FamInstEnv (FamInstEnvs)
import GHC.Exts (fromString)
import GHC.Generics
import GHC.SourceGen (var)
-import GhcPlugins (GlobalRdrElt, mkRdrUnqual)
-import InstEnv (InstEnvs(..))
-import OccName
import Refinery.ProofState
import Refinery.Tactic
import Refinery.Tactic.Internal (TacticT(TacticT), RuleT (RuleT))
import System.IO.Unsafe (unsafePerformIO)
-import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst)
-import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply)
-import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique, mkUnique)
import Wingman.Debug
-import Data.IORef
+import Data.IORef
------------------------------------------------------------------------------
@@ -199,7 +192,7 @@ defaultTacticState =
------------------------------------------------------------------------------
-- | Generate a new 'Unique'
-freshUnique :: MonadState TacticState m => m Unique
+freshUnique :: MonadState TacticState m => m Util.Unique
freshUnique = do
(uniq, supply) <- gets $ takeUniqFromSupply . ts_unique_gen
modify' $! field @"ts_unique_gen" .~ supply
@@ -269,11 +262,11 @@ newtype Uniquely a = Uniquely { getViaUnique :: a }
deriving Show via a
deriving stock (Data, Typeable)
-instance Uniquable a => Eq (Uniquely a) where
- (==) = (==) `on` getUnique . getViaUnique
+instance Util.Uniquable a => Eq (Uniquely a) where
+ (==) = (==) `on` Util.getUnique . getViaUnique
-instance Uniquable a => Ord (Uniquely a) where
- compare = nonDetCmpUnique `on` getUnique . getViaUnique
+instance Util.Uniquable a => Ord (Uniquely a) where
+ compare = Util.nonDetCmpUnique `on` Util.getUnique . getViaUnique
-- NOTE(sandy): The usage of list here is mostly for convenience, but if it's
@@ -349,7 +342,7 @@ instance MonadReader r m => MonadReader r (RuleT jdg ext err s m) where
local f (RuleT m) = RuleT $ Effect $ local f $ pure m
mkMetaHoleName :: Int -> RdrName
-mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (mkUnique 'w' u)
+mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (Util.mkUnique 'w' u)
instance MetaSubst Int (Synthesized (LHsExpr GhcPs)) where
-- TODO(sandy): This join is to combine the synthesizeds
diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml
index 13663cba29de070b20e3ff0cf8c22e933bd4544a..085909f607941655dbf069c2d8a15b6b7bd410d1 100644
--- a/stack-8.10.2.yaml
+++ b/stack-8.10.2.yaml
@@ -38,7 +38,6 @@ extra-deps:
- data-tree-print-0.1.0.2@rev:2
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-lib-8.10.4.20210206
@@ -57,7 +56,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
- dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682
diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml
index a24c3512d3be76cee6b2a2fb351d07850d2d6ad3..8ce1cce93238fd62668d81396475995f6b581080 100644
--- a/stack-8.10.3.yaml
+++ b/stack-8.10.3.yaml
@@ -38,7 +38,6 @@ extra-deps:
- data-tree-print-0.1.0.2@rev:2
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-lib-8.10.4.20210206
@@ -57,7 +56,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
- dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682
diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml
index f00ff4d0148349722473204758abe961d2e802e4..82f9d4dc33837ceeac257a5e2ca4a98ff3ca5be0 100644
--- a/stack-8.10.4.yaml
+++ b/stack-8.10.4.yaml
@@ -38,7 +38,6 @@ extra-deps:
- data-tree-print-0.1.0.2@rev:2
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-source-gen-0.4.1.0
@@ -53,7 +52,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
- dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682
diff --git a/stack-8.10.5.yaml b/stack-8.10.5.yaml
index b97fc70e81968d7cd03bf4064273541cc1b81d87..f94d4f74ef3295d586c1d7fe096611e692c0a3bd 100644
--- a/stack-8.10.5.yaml
+++ b/stack-8.10.5.yaml
@@ -41,7 +41,6 @@ extra-deps:
- data-tree-print-0.1.0.2@rev:2
- floskell-0.10.5
- fourmolu-0.3.0.0
- - ghc-api-compat-8.10.5
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-source-gen-0.4.1.0
@@ -58,7 +57,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
- dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682
diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml
index 2675a9bbdc41e921d1332f35109b01aeb44ab5c5..41bedc7cb904870603488a38de5d07182586ae40 100644
--- a/stack-8.10.6.yaml
+++ b/stack-8.10.6.yaml
@@ -35,9 +35,8 @@ extra-deps:
- bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738
- data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620
- floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803
- - ghc-api-compat-8.10.6@sha256:cde370b1b4c8a090de1ba6a8e27f65def9af43ca88710b412a6545b876568626,3324
- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417
- - hiedb-0.4.0.0@sha256:b6dadd5cefc8c1052bc4b29144f616ca9c22e863a96d8e447d66a4d32c96fd4a,2987
+ - hiedb-0.4.1.0
- implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998
- implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610
- lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431
diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml
index 3959b71d80a3a481c0df4c035ce114fb41a55f9e..fbaf2d380eeb6122127d7318b0913ff4092b592d 100644
--- a/stack-8.10.7.yaml
+++ b/stack-8.10.7.yaml
@@ -35,9 +35,8 @@ extra-deps:
- bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738
- data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620
- floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803
- - ghc-api-compat-8.10.7
- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417
- - hiedb-0.4.0.0@sha256:b6dadd5cefc8c1052bc4b29144f616ca9c22e863a96d8e447d66a4d32c96fd4a,2987
+ - hiedb-0.4.1.0
- implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998
- implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610
- lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431
diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml
index 82c9b6628bf18e89b0d1f4d5b2266e9e3e60d22e..5329bef27facc36c6e7a01663066831a2ef0ee94 100644
--- a/stack-8.6.4.yaml
+++ b/stack-8.6.4.yaml
@@ -45,7 +45,6 @@ extra-deps:
- floskell-0.10.4
- fourmolu-0.3.0.0
- fuzzy-0.1.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-events-0.13.0
- ghc-exactprint-0.6.4
@@ -92,7 +91,7 @@ extra-deps:
- th-env-0.1.0.2@sha256:d8f1f37f42a8f1a22404d7d0579528af18f5dac7232cca6bdbd5117c115a0ad5,1370
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml
index 51d44735324e2196b2b6443edd83b23e73dcd8b9..cb42915a43f8ec438f7d37194926d8b8dad74b0a 100644
--- a/stack-8.6.5.yaml
+++ b/stack-8.6.5.yaml
@@ -46,7 +46,6 @@ extra-deps:
- floskell-0.10.4
- fourmolu-0.3.0.0
- fuzzy-0.1.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-events-0.13.0
- ghc-exactprint-0.6.4
@@ -93,7 +92,7 @@ extra-deps:
- th-env-0.1.0.2@sha256:d8f1f37f42a8f1a22404d7d0579528af18f5dac7232cca6bdbd5117c115a0ad5,1370
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml
index e1fc082b9656d6c02eb8acb2321a4ea8c390ff11..42a23df0c41f4d9516c2895c633f557a2c90c746 100644
--- a/stack-8.8.3.yaml
+++ b/stack-8.8.3.yaml
@@ -40,7 +40,6 @@ extra-deps:
- constrained-dynamic-0.1.0.0
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-lib-8.10.4.20210206
@@ -71,7 +70,7 @@ extra-deps:
- uniplate-1.6.13
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
- direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
- extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683
diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml
index 3742c83f56e77baa15e76edae1f79203e4f603a2..444168f8ce788ccb0ccf31627545029fe3bef12e 100644
--- a/stack-8.8.4.yaml
+++ b/stack-8.8.4.yaml
@@ -40,7 +40,6 @@ extra-deps:
- constrained-dynamic-0.1.0.0
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-check-0.5.0.4
- ghc-exactprint-0.6.4
- ghc-lib-8.10.4.20210206
@@ -69,7 +68,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
- direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml
index 5e71865dac20ce7cc8b8c1f4bfb6f16717f087dd..010e96af4ad006e106e0bf7e965b783b1b65ad8a 100644
--- a/stack-9.0.1.yaml
+++ b/stack-9.0.1.yaml
@@ -13,11 +13,11 @@ packages:
- ./plugins/hls-haddock-comments-plugin
- ./plugins/hls-eval-plugin
- ./plugins/hls-explicit-imports-plugin
- # - ./plugins/hls-refine-imports-plugin
+ - ./plugins/hls-refine-imports-plugin
- ./plugins/hls-hlint-plugin
- ./plugins/hls-rename-plugin
- ./plugins/hls-retrie-plugin
- # - ./plugins/hls-splice-plugin
+ - ./plugins/hls-splice-plugin
# - ./plugins/hls-tactics-plugin
# - ./plugins/hls-brittany-plugin
# - ./plugins/hls-stylish-haskell-plugin
@@ -37,11 +37,10 @@ extra-deps:
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147
- floskell-0.10.5
-- ghc-api-compat-9.0.1
- ghc-source-gen-0.4.1.0
- heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417
- hie-bios-0.7.6
-- hiedb-0.4.0.0
+- hiedb-0.4.1.0
- hspec-2.7.10
- hspec-core-2.7.10
- hspec-discover-2.7.10
@@ -104,8 +103,6 @@ flags:
pedantic: true
class: false
- splice: false
- refineImports: false
tactic: false # Dependencies fail
fourmolu: false
diff --git a/stack.yaml b/stack.yaml
index 67e3104e9f7bee6906795987632af93b62e0933b..7c78883d2780db6ac3350e14958c559125bb4365 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -38,7 +38,6 @@ extra-deps:
- data-tree-print-0.1.0.2@rev:2
- floskell-0.10.4
- fourmolu-0.3.0.0
- - ghc-api-compat-8.6
- ghc-exactprint-0.6.4
- ghc-source-gen-0.4.1.0
- heapsize-0.3.0
@@ -52,7 +51,7 @@ extra-deps:
- temporary-1.2.1.1
- th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854
- bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727
- - hiedb-0.4.0.0
+ - hiedb-0.4.1.0
- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657
- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068
- dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682