From d7f9f02eeb3af414e9958bba52db093436d36c7a Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 13 Oct 2022 18:10:04 +0100 Subject: [PATCH] Purge GHC 8.8 We're also dropping support for this. --- .circleci/config.yml | 6 - .github/workflows/caching.yml | 1 - .github/workflows/flags.yml | 1 - .github/workflows/hackage.yml | 1 - .github/workflows/test.yml | 67 +- .gitpod.Dockerfile | 1 - bindist/ghcs | 1 - docs/contributing/contributing.md | 8 +- docs/contributing/plugin-tutorial.md | 2 +- docs/installation.md | 2 +- docs/support/ghc-version-support.md | 2 +- ghcide-bench/ghcide-bench.cabal | 2 +- ghcide/ghcide.cabal | 4 +- ghcide/src/Development/IDE/Core/Compile.hs | 18 +- ghcide/src/Development/IDE/GHC/CPP.hs | 23 +- ghcide/src/Development/IDE/GHC/Compat.hs | 26 +- ghcide/src/Development/IDE/GHC/Compat/CPP.hs | 4 - ghcide/src/Development/IDE/GHC/Compat/Core.hs | 80 +- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 6 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 5 - ghcide/src/Development/IDE/GHC/Util.hs | 7 - ghcide/src/Development/IDE/LSP/Outline.hs | 4 - .../IDE/Plugin/Completions/Logic.hs | 7 - ghcide/src/Development/IDE/Spans/Pragmas.hs | 13 - ghcide/test/exe/Main.hs | 18 +- ghcide/test/ghcide-test-utils.cabal | 2 +- haskell-language-server.cabal | 4 +- hie-compat/hie-compat.cabal | 2 - hie-compat/src-ghc88/Compat/HieAst.hs | 1760 ----------------- hie-compat/src-ghc88/Compat/HieBin.hs | 389 ---- .../src/Ide/Plugin/Literals.hs | 11 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 3 - .../src/Development/IDE/GHC/Dump.hs | 4 - .../src/Development/IDE/GHC/ExactPrint.hs | 5 - .../src/Ide/Plugin/Retrie.hs | 4 - .../src/Ide/Plugin/Splice.hs | 3 - plugins/hls-stan-plugin/hls-stan-plugin.cabal | 4 +- .../src/Wingman/AbstractLSP/TacticActions.hs | 4 +- plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 25 - .../src/Wingman/LanguageServer.hs | 7 - stack-lts16.yaml | 129 -- test/functional/Completion.hs | 2 +- test/functional/TypeDefinition.hs | 3 +- test/wrapper/Main.hs | 1 - test/wrapper/testdata/stack-8.8.4/Lib.hs | 2 - test/wrapper/testdata/stack-8.8.4/foo.cabal | 7 - test/wrapper/testdata/stack-8.8.4/stack.yaml | 1 - 47 files changed, 66 insertions(+), 2615 deletions(-) delete mode 100644 hie-compat/src-ghc88/Compat/HieAst.hs delete mode 100644 hie-compat/src-ghc88/Compat/HieBin.hs delete mode 100644 stack-lts16.yaml delete mode 100644 test/wrapper/testdata/stack-8.8.4/Lib.hs delete mode 100644 test/wrapper/testdata/stack-8.8.4/foo.cabal delete mode 100644 test/wrapper/testdata/stack-8.8.4/stack.yaml diff --git a/.circleci/config.yml b/.circleci/config.yml index 91f6e2e89c..22aa3f0639 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -75,11 +75,6 @@ defaults: &defaults version: 2 jobs: - stackage-lts16: - environment: - - STACK_FILE: "stack-lts16.yaml" - <<: *defaults - stackage-lts19: environment: - STACK_FILE: "stack-lts19.yaml" @@ -95,6 +90,5 @@ workflows: version: 2 multiple-ghcs: jobs: - - stackage-lts16 - stackage-lts19 - stackage-nightly diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index ae4c9c07fe..b0887b51b9 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -84,7 +84,6 @@ jobs: , "9.2.3" , "9.0.2" , "8.10.7" - , "8.8.4" ] os: [ "ubuntu-latest" , "macOS-latest" diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index a4f070a4da..44b329a833 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -47,7 +47,6 @@ jobs: ghc: [ "9.2.4" , "9.0.2" , "8.10.7" - , "8.8.4" ] os: [ "ubuntu-latest" ] diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 4378b8ffb7..68f7de50d6 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -40,7 +40,6 @@ jobs: "haskell-language-server"] ghc: [ "9.0.2" , "8.10.7" - , "8.8.4" ] exclude: - ghc: "9.0.2" diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 78bcf83e15..99821468ff 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -63,7 +63,6 @@ jobs: , "9.2.3" , "9.0.2" , "8.10.7" - , "8.8.4" ] os: [ "ubuntu-latest" , "macOS-latest" @@ -82,9 +81,6 @@ jobs: - os: ubuntu-latest ghc: '8.10.7' test: true - - os: ubuntu-latest - ghc: '8.8.4' - test: true - os: windows-latest ghc: '9.4.2' test: true @@ -98,8 +94,6 @@ jobs: ghc: '8.10.7' test: true # only build rest of supported ghc versions for windows - - os: windows-latest - ghc: '8.8.4' - os: windows-latest ghc: '9.2.3' @@ -111,9 +105,8 @@ jobs: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} - # repeating builds to workaround segfaults in windows and ghc-8.8.4 - name: Build - run: cabal build || cabal build || cabal build + run: cabal build - name: Set test options # run the tests without parallelism, otherwise tasty will attempt to run @@ -137,125 +130,125 @@ jobs: - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test name: Test ghcide # run the tests without parallelism to avoid running out of memory - run: cabal test ghcide --test-options="$TEST_OPTS" || cabal test ghcide --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test ghcide --test-options="$TEST_OPTS" + run: cabal test ghcide --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test ghcide --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-plugin-api - run: cabal test hls-plugin-api --test-options="$TEST_OPTS" || cabal test hls-plugin-api --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-plugin-api --test-options="$TEST_OPTS" + run: cabal test hls-plugin-api --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-plugin-api --test-options="$TEST_OPTS" - if: matrix.test name: Test func-test suite env: HLS_TEST_EXE: hls HLS_WRAPPER_TEST_EXE: hls-wrapper - run: cabal test func-test --test-options="$TEST_OPTS" || cabal test func-test --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test func-test --test-options="$TEST_OPTS" + run: cabal test func-test --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test func-test --test-options="$TEST_OPTS" - if: matrix.test name: Test wrapper-test suite env: HLS_TEST_EXE: hls HLS_WRAPPER_TEST_EXE: hls-wrapper - run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" + run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-brittany-plugin - run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" + run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-refactor-plugin - run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refactor-plugin --test-options="$TEST_OPTS" + run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refactor-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-floskell-plugin - run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" + run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-class-plugin - run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" + run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-pragmas-plugin - run: cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" + run: cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-eval-plugin - run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS" + run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-haddock-comments-plugin - run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" + run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-splice-plugin - run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || cabal test hls-splice-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="$TEST_OPTS" + run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-stylish-haskell-plugin - run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" + run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-ormolu-plugin - run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" + run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-fourmolu-plugin - run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" + run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-tactics-plugin test suite - run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" + run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-refine-imports-plugin test suite - run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" + run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-explicit-imports-plugin test suite - run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" + run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-call-hierarchy-plugin test suite - run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" + run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.4.2' name: Test hls-rename-plugin test suite - run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" + run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-hlint-plugin test suite - run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" + run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.0.2' && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-stan-plugin test suite - run: cabal test hls-stan-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stan-plugin --test-options="$TEST_OPTS" + run: cabal test hls-stan-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stan-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-module-name-plugin test suite - run: cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-module-name-plugin --test-options="$TEST_OPTS" + run: cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-module-name-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-alternate-number-format-plugin test suite - run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" + run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-qualify-imported-names-plugin test suite - run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" + run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-code-range-plugin test suite - run: cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-code-range-plugin --test-options="$TEST_OPTS" + run: cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-code-range-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-change-type-signature test suite - run: cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" + run: cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-gadt-plugin test suit - run: cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-gadt-plugin --test-options="$TEST_OPTS" + run: cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-gadt-plugin --test-options="$TEST_OPTS" - if: matrix.test name: Test hls-explicit-fixity-plugin test suite - run: cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" + run: cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" test_post_job: if: always() diff --git a/.gitpod.Dockerfile b/.gitpod.Dockerfile index 87dc2ff6a1..b35e86ebe1 100644 --- a/.gitpod.Dockerfile +++ b/.gitpod.Dockerfile @@ -7,7 +7,6 @@ RUN sudo install-packages build-essential curl libffi-dev libffi7 libgmp-dev lib echo 'export PATH=$HOME/.cabal/bin:$HOME/.local/bin:$PATH' >> $HOME/.bashrc && \ . /home/gitpod/.ghcup/env && \ # Install all verions of GHC that HLS supports. Putting GHC into Docker image makes workspace start much faster. - ghcup install ghc 8.8.4 && \ ghcup install ghc 8.10.7 && \ ghcup install ghc 9.0.2 && \ ghcup install ghc 9.2.3 && \ diff --git a/bindist/ghcs b/bindist/ghcs index d1c741c324..17e3ffea1c 100644 --- a/bindist/ghcs +++ b/bindist/ghcs @@ -1,4 +1,3 @@ -8.8.4,cabal.project 8.10.7,cabal.project 9.0.2,cabal.project 9.2.3,cabal.project diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index f8f705da1c..7ddeada313 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -51,18 +51,14 @@ If you are using nix 2.4 style command (enabled by `experimental-features = nix- you can use `nix develop` instead of `nix-shell` to enter the development shell. To enter the shell with specific GHC versions: * `nix develop` or `nix develop .#haskell-language-server-dev` - default GHC version -* `nix develop .#haskell-language-server-8107-dev` - GHC 8.10.7 -* `nix develop .#haskell-language-server-884-dev` - GHC 8.8.4 -* `nix develop .#haskell-language-server-901-dev` - GHC 9.0.1 +* `nix develop .#haskell-language-server-901-dev` - GHC 9.0.1 (substitute GHC version as appropriate) If you are looking for a Nix expression to create haskell-language-server binaries, see https://github.com/haskell/haskell-language-server/issues/122 To create binaries: * `nix build` or `nix build .#haskell-language-server` - default GHC version -* `nix build .#haskell-language-server-8107` - GHC 8.10.7 -* `nix build .#haskell-language-server-884` - GHC 8.8.4 -* `nix build .#haskell-language-server-901` - GHC 9.0.1 +* `nix build .#haskell-language-server-901` - GHC 9.0.1 (substitute GHC version as appropriate) ## Testing diff --git a/docs/contributing/plugin-tutorial.md b/docs/contributing/plugin-tutorial.md index 53bcfb1a4f..56f1765af2 100644 --- a/docs/contributing/plugin-tutorial.md +++ b/docs/contributing/plugin-tutorial.md @@ -34,7 +34,7 @@ And here is the gist of the algorithm: ## Setup -To get started, let’s fetch the HLS repo and build it. You need at least GHC 8.8 for this: +To get started, let’s fetch the HLS repo and build it. You need at least GHC 8.10 for this: ``` git clone --recursive http://github.com/haskell/haskell-language-server hls diff --git a/docs/installation.md b/docs/installation.md index 7ebfbb432f..b3f8270288 100644 --- a/docs/installation.md +++ b/docs/installation.md @@ -157,7 +157,7 @@ Homebrew users can install `haskell-language-server` using the following command brew install haskell-language-server ``` -This formula contains HLS binaries compiled with GHC versions available via Homebrew; at the moment those are: 8.8.4, 8.10.7. +This formula contains HLS binaries compiled with GHC versions available via Homebrew; at the moment those are: 8.10.7. You need to provide your own GHC/Cabal/Stack as required by your project, possibly via Homebrew. diff --git a/docs/support/ghc-version-support.md b/docs/support/ghc-version-support.md index da7887f1fc..9af9d7ed46 100644 --- a/docs/support/ghc-version-support.md +++ b/docs/support/ghc-version-support.md @@ -29,7 +29,7 @@ Support status (see the support policy below for more details): | 8.10.5 | [1.5.1](https://github.com/haskell/haskell-language-server/releases/tag/1.5.1) | deprecated | | 8.10.(4,3,2) | [1.4.0](https://github.com/haskell/haskell-language-server/releases/tag/1.4.0) | deprecated | | 8.10.1 | [0.9.0](https://github.com/haskell/haskell-language-server/releases/tag/0.9.0) | deprecated | -| 8.8.4 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support, will be deprecated after LTS and HLS full support for ghc-9.2 | +| 8.8.4 | [1.8.0](https://github.com/haskell/haskell-language-server/releases/1.8.0) | deprecated | | 8.8.3 | [1.5.1](https://github.com/haskell/haskell-language-server/releases/1.5.1) | deprecated | | 8.8.2 | [1.2.0](https://github.com/haskell/haskell-language-server/releases/tag/1.2.0) | deprecated | | 8.6.5 | [1.8.0.0](https://github.com/haskell/haskell-language-server/releases/tag/1.8.0.0) | deprecated | diff --git a/ghcide-bench/ghcide-bench.cabal b/ghcide-bench/ghcide-bench.cabal index f48484de96..24e9ee2c80 100644 --- a/ghcide-bench/ghcide-bench.cabal +++ b/ghcide-bench/ghcide-bench.cabal @@ -12,7 +12,7 @@ synopsis: An LSP client for running performance experiments on HLS description: An LSP client for running performance experiments on HLS homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme bug-reports: https://github.com/haskell/haskell-language-server/issues -tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 +tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 source-repository head type: git diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index abf724fc64..2b3ac1dbba 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -13,7 +13,7 @@ description: A library for building Haskell IDE's on top of the GHC API. homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme bug-reports: https://github.com/haskell/haskell-language-server/issues -tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 +tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 extra-source-files: README.md CHANGELOG.md test/data/**/*.project test/data/**/*.cabal @@ -99,7 +99,7 @@ library unliftio-core, ghc-boot-th, ghc-boot, - ghc >= 8.8, + ghc >= 8.10, ghc-check >=0.5.0.8, ghc-paths, cryptohash-sha1 >=0.11.100 && <0.12, diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index c8527d115d..978e0ceccb 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -104,10 +104,6 @@ import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) import Unsafe.Coerce -#if !MIN_VERSION_ghc(8,10,0) -import ErrUtils -#endif - #if MIN_VERSION_ghc(9,0,1) import GHC.Tc.Gen.Splice @@ -482,11 +478,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do Nothing #endif -#elif MIN_VERSION_ghc(8,10,0) +#else let !partial_iface = force (mkPartialIface session details simplified_guts) final_iface <- mkFullIface session partial_iface -#else - (final_iface,_) <- mkIface session Nothing details simplified_guts #endif -- Write the core file now @@ -637,11 +631,7 @@ generateObjectCode session summary guts = do #else (outputFilename, _mStub, _foreign_files) <- hscGenHardCode session' guts #endif -#if MIN_VERSION_ghc(8,10,0) (ms_location summary) -#else - summary -#endif fp obj <- compileFile session' driverNoStop (outputFilename, Just (As False)) #if MIN_VERSION_ghc(9,3,0) @@ -670,11 +660,7 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do -- 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') -#else - summary' -#endif let unlinked = BCOs bytecode sptEntries let linkable = LM time (ms_mod summary) [unlinked] pure (map snd warnings, linkable) @@ -739,9 +725,7 @@ unnecessaryDeprecationWarningFlags , Opt_WarnUnusedMatches , Opt_WarnUnusedTypePatterns , Opt_WarnUnusedForalls -#if MIN_VERSION_ghc(8,10,0) , Opt_WarnUnusedRecordWildcards -#endif , Opt_WarnInaccessibleCode , Opt_WarnWarningsDeprecations ] diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index d0aaec5e95..7495de21a4 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -16,30 +16,21 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where import Development.IDE.GHC.Compat as Compat -import GHC -#if !MIN_VERSION_ghc(8,10,0) -import qualified Development.IDE.GHC.Compat.CPP as CPP -#else import Development.IDE.GHC.Compat.Util -#endif +import GHC #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) +#elif MIN_VERSION_ghc (8,10,0) import qualified DriverPipeline as Pipeline import ToolSettings -#else -import DynFlags -#endif #endif #if MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif addOptP :: String -> DynFlags -> DynFlags -#if MIN_VERSION_ghc (8,10,0) addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s , toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s) @@ -47,20 +38,12 @@ addOptP f = alterToolSettings $ \s -> s where fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -#else -addOptP opt = onSettings (onOptP (opt:)) - where - onSettings f x = x{settings = f $ settings x} - onOptP f x = x{sOpt_P = f $ sOpt_P x} -#endif 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 + Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index b853fb0a25..216039cd1c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -244,10 +244,6 @@ import Data.List (foldl') import qualified Data.Map as Map import qualified Data.Set as S -#if !MIN_VERSION_ghc(8,10,0) -import Bag (unitBag) -#endif - #if MIN_VERSION_ghc(9,2,0) import GHC.Builtin.Uniques import GHC.ByteCode.Types @@ -404,17 +400,10 @@ pattern PFailedWithErrorMessages msgs #else <- PFailed (const . fmap pprError . getErrorMessages -> msgs) #endif -#elif MIN_VERSION_ghc(8,10,0) -pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a -pattern PFailedWithErrorMessages msgs - <- PFailed (getErrorMessages -> msgs) #else pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a pattern PFailedWithErrorMessages msgs - <- ((fmap.fmap) unitBag . mkPlainErrMsgIfPFailed -> Just msgs) - -mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err) -mkPlainErrMsgIfPFailed _ = Nothing + <- PFailed (getErrorMessages -> msgs) #endif {-# COMPLETE POk, PFailedWithErrorMessages #-} @@ -488,11 +477,7 @@ nameListFromAvails as = getModuleHash :: ModIface -> Fingerprint -#if MIN_VERSION_ghc(8,10,0) getModuleHash = mi_mod_hash . mi_final_exts -#else -getModuleHash = mi_mod_hash -#endif disableWarningsAsErrors :: DynFlags -> DynFlags @@ -500,12 +485,8 @@ disableWarningsAsErrors df = flip gopt_unset Opt_WarnIsError $ foldl' wopt_unset_fatal df [toEnum 0 ..] isQualifiedImport :: ImportDecl a -> Bool -#if MIN_VERSION_ghc(8,10,0) isQualifiedImport ImportDecl{ideclQualified = NotQualified} = False isQualifiedImport ImportDecl{} = True -#else -isQualifiedImport ImportDecl{ideclQualified} = ideclQualified -#endif isQualifiedImport _ = False @@ -566,8 +547,7 @@ generatedNodeInfo = sourceNodeInfo -- before ghc 9.0, we don't distinguish the s #endif data GhcVersion - = GHC88 - | GHC810 + = GHC810 | GHC90 | GHC92 | GHC94 @@ -585,8 +565,6 @@ ghcVersion = GHC92 ghcVersion = GHC90 #elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) ghcVersion = GHC810 -#elif MIN_VERSION_GLASGOW_HASKELL(8,8,0,0) -ghcVersion = GHC88 #endif runUnlit :: Logger -> DynFlags -> [Option] -> IO () diff --git a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs index 831ecfa3cc..9da9fa4786 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs @@ -48,11 +48,7 @@ doCpp dflags raw input_fn output_fn = do 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 = diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 88acf5cde4..af5c8c1ace 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -76,12 +76,8 @@ module Development.IDE.GHC.Compat.Core ( -- * Interface Files IfaceExport, IfaceTyCon(..), -#if MIN_VERSION_ghc(8,10,0) ModIface, ModIface_(..), -#else - ModIface(..), -#endif HscSource(..), WhereFrom(..), loadInterface, @@ -90,12 +86,8 @@ module Development.IDE.GHC.Compat.Core ( #endif loadModuleInterface, RecompileRequired(..), -#if MIN_VERSION_ghc(8,10,0) mkPartialIface, mkFullIface, -#else - mkIface, -#endif checkOldIface, #if MIN_VERSION_ghc(9,0,0) IsBootInterface(..), @@ -141,7 +133,7 @@ module Development.IDE.GHC.Compat.Core ( #if !MIN_VERSION_ghc(9,2,0) Development.IDE.GHC.Compat.Core.splitForAllTyCoVars, #endif - Development.IDE.GHC.Compat.Core.mkVisFunTys, + mkVisFunTys, Development.IDE.GHC.Compat.Core.mkInfForAllTys, -- * Specs ImpDeclSpec(..), @@ -261,9 +253,6 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.noSrcSpan, SrcLoc.noSrcLoc, SrcLoc.noLoc, -#if !MIN_VERSION_ghc(8,10,0) - SrcLoc.dL, -#endif -- * Finder FindResult(..), mkHomeModLocation, @@ -403,10 +392,8 @@ module Development.IDE.GHC.Compat.Core ( #else module BasicTypes, module Class, -#if MIN_VERSION_ghc(8,10,0) module Coercion, module Predicate, -#endif module ConLike, module CoreUtils, module DataCon, @@ -453,22 +440,7 @@ module Development.IDE.GHC.Compat.Core ( 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, @@ -541,8 +513,7 @@ 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.Type hiding (mkInfForAllTys) import GHC.Core.Unify import GHC.Core.Utils @@ -693,29 +664,13 @@ import ExtractDocs import FamInst import FamInstEnv import Finder hiding (mkHomeModLocation) -#if MIN_VERSION_ghc(8,10,0) import GHC.Hs hiding (HsLet, LetStmt) -#endif import qualified GHCi import GhcMonad import HeaderInfo hiding (getImports) import Hooks import HscMain as GHC import HscTypes -#if !MIN_VERSION_ghc(8,10,0) --- Syntax imports -import HsBinds -import HsDecls -import HsDoc -import HsExpr hiding (HsLet, LetStmt) -import HsExtension -import HsImpExp -import HsLit -import HsPat -import HsSyn hiding (wildCardName, HsLet, LetStmt) -import HsTypes hiding (wildCardName) -import HsUtils -#endif import Id import IfaceSyn import InstEnv @@ -755,12 +710,12 @@ import TcRnMonad hiding (Applicative (..), IORef, allM, anyM, concatMapM, foldrM, mapMaybeM, (<$>)) import TcRnTypes -import TcType hiding (mkVisFunTys) +import TcType import qualified TcType import TidyPgm as GHC import qualified TyCoRep import TyCon -import Type hiding (mkVisFunTys) +import Type import TysPrim import TysWiredIn import Unify @@ -769,16 +724,10 @@ import UniqSupply import Var (Var (varName), setTyVarUnique, setVarUnique, varType) -#if MIN_VERSION_ghc(8,10,0) import Coercion (coercionKind) import Predicate import SrcLoc (Located, SrcLoc (UnhelpfulLoc), SrcSpan (UnhelpfulSpan)) -#else -import SrcLoc (RealLocated, - SrcLoc (UnhelpfulLoc), - SrcSpan (UnhelpfulSpan)) -#endif #endif @@ -890,11 +839,7 @@ 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) @@ -941,14 +886,6 @@ unrestricted :: a -> Scaled a unrestricted = 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) @@ -981,11 +918,6 @@ tcSplitForAllTyVarBinder_maybe = #endif -#if !MIN_VERSION_ghc(8,10,0) -noExtField :: GHC.NoExt -noExtField = GHC.noExt -#endif - #if !MIN_VERSION_ghc(9,0,0) pattern NotBoot, IsBoot :: IsBootInterface pattern NotBoot = False @@ -1132,15 +1064,11 @@ makeSimpleDetails hsc_env = #endif mkIfaceTc hsc_env sf details ms tcGblEnv = -#if MIN_VERSION_ghc(8,10,0) GHC.mkIfaceTc hsc_env sf details #if MIN_VERSION_ghc(9,3,0) ms #endif tcGblEnv -#else - fst <$> GHC.mkIfaceTc hsc_env Nothing sf details tcGblEnv -#endif mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc session = GHC.mkBootModDetailsTc diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 7c521e88e8..c726bfad4c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -30,10 +30,8 @@ module Development.IDE.GHC.Compat.Util ( -- * Maybes MaybeErr(..), orElse, -#if MIN_VERSION_ghc(8,10,0) -- * Pair Pair(..), -#endif -- * EnumSet EnumSet, toList, @@ -97,10 +95,8 @@ import qualified Exception import FastString import Fingerprint import Maybes -#if MIN_VERSION_ghc(8,10,0) -import Pair -#endif import Outputable (pprHsString) +import Pair import Panic hiding (try) import StringBuffer import UniqDFM diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 6a2ddc7586..9e3d206d0e 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -104,11 +104,6 @@ instance Show ParsedModule where instance NFData ModSummary where rnf = rwhnf -#if !MIN_VERSION_ghc(8,10,0) -instance NFData FastString where - rnf = rwhnf -#endif - #if MIN_VERSION_ghc(9,2,0) instance Ord FastString where compare a b = if a == b then EQ else compare (fs_sbs a) (fs_sbs b) diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 69cc2adf77..70486f4d74 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -280,13 +280,6 @@ ioe_dupHandlesNotCompatible h = -------------------------------------------------------------------------------- -- Tracing exactprint terms --- Should in `Development.IDE.GHC.Orphans`, --- leave it here to prevent cyclic module dependency -#if !MIN_VERSION_ghc(8,10,0) -instance Outputable SDoc where - ppr = id -#endif - -- | Print a GHC value in `defaultUserStyle` without unique symbols. -- It uses `showSDocUnsafe` with `unsafeGlobalDynFlags` internally. -- diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 2ad518d588..b31cd90f7b 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -248,11 +248,7 @@ documentSymbolForImport (L (locA -> (RealSrcSpan l _)) ImportDecl { ideclName, i (defDocumentSymbol l :: DocumentSymbol) { _name = "import " <> printOutputable ideclName , _kind = SkModule -#if MIN_VERSION_ghc(8,10,0) , _detail = case ideclQualified of { NotQualified -> Nothing; _ -> Just "qualified" } -#else - , _detail = if ideclQualified then Just "qualified" else Nothing -#endif } documentSymbolForImport _ = Nothing diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 78a921bec4..7d2190cac8 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -290,12 +290,8 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = then getArgs ret else Prelude.filter (not . isDictTy) $ map scaledThing args | isPiTy t = getArgs $ snd (splitPiTys t) -#if MIN_VERSION_ghc(8,10,0) | Just (Pair _ t) <- coercionKind <$> isCoercionTy_maybe t = getArgs t -#else - | isCoercionTy t = maybe [] (getArgs . snd) (splitCoercionType_maybe t) -#endif | otherwise = [] @@ -766,9 +762,6 @@ uniqueCompl candidate unique = importedFrom (provenance -> ImportedFrom m) = m importedFrom (provenance -> DefinedIn m) = m importedFrom (provenance -> Local _) = "local" -#if __GLASGOW_HASKELL__ < 810 - importedFrom _ = "" -#endif -- --------------------------------------------------------------------- -- helper functions for infix backticks diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index f22acf04c3..02d3db2721 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -416,23 +416,10 @@ mkLexerPState dynFlags stringBuffer = startRealSrcLoc = mkRealSrcLoc "asdf" 1 1 updateDynFlags = flip gopt_unset Opt_Haddock . flip gopt_set Opt_KeepRawTokenStream finalDynFlags = updateDynFlags dynFlags -#if !MIN_VERSION_ghc(8,10,1) - mkLexerParserFlags = - mkParserFlags' - <$> warningFlags - <*> extensionFlags - <*> homeUnitId_ - <*> safeImportsOn - <*> gopt Opt_Haddock - <*> gopt Opt_KeepRawTokenStream - <*> const False - finalPState = mkPStatePure (mkLexerParserFlags finalDynFlags) stringBuffer startRealSrcLoc -#else pState = initParserState (initParserOpts finalDynFlags) stringBuffer startRealSrcLoc PState{ options = pStateOptions } = pState finalExtBitsMap = setBit (pExtsBitmap pStateOptions) (fromEnum UsePosPragsBit) finalPStateOptions = pStateOptions{ pExtsBitmap = finalExtBitsMap } finalPState = pState{ options = finalPStateOptions } -#endif in finalPState diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 384efce985..81597e1efd 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1186,7 +1186,7 @@ checkFileCompiles fp diag = pluginSimpleTests :: TestTree pluginSimpleTests = - ignoreInWindowsForGHC88And810 $ + ignoreInWindowsForGHC810 $ ignoreForGHC92Plus "blocked on ghc-typelits-natnormalise" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" @@ -1201,7 +1201,7 @@ pluginSimpleTests = pluginParsedResultTests :: TestTree pluginParsedResultTests = - ignoreInWindowsForGHC88And810 $ + ignoreInWindowsForGHC810 $ ignoreForGHC92Plus "No need for this plugin anymore!" $ testSessionWithExtraFiles "plugin-recorddot" "parsedResultAction plugin" $ \dir -> do _ <- openDoc (dir "RecordDot.hs") "haskell" @@ -1370,7 +1370,7 @@ thTests = _ <- createDoc "A.hs" "haskell" sourceA _ <- createDoc "B.hs" "haskell" sourceB expectDiagnostics [ ( "B.hs", [(DsWarning, (4, 0), "Top-level binding with no type signature: main :: IO ()")] ) ] - , ignoreInWindowsForGHC88 $ testCase "findsTHnewNameConstructor" $ runWithExtraFiles "THNewName" $ \dir -> do + , testCase "findsTHnewNameConstructor" $ runWithExtraFiles "THNewName" $ \dir -> do -- This test defines a TH value with the meaning "data A = A" in A.hs -- Loads and export the template in B.hs @@ -2273,17 +2273,13 @@ xfail = flip expectFailBecause ignoreInWindowsBecause :: String -> TestTree -> TestTree ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows) -ignoreInWindowsForGHC88And810 :: TestTree -> TestTree -ignoreInWindowsForGHC88And810 = - ignoreFor (BrokenSpecific Windows [GHC88, GHC810]) "tests are unreliable in windows for ghc 8.8 and 8.10" +ignoreInWindowsForGHC810 :: TestTree -> TestTree +ignoreInWindowsForGHC810 = + ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10" ignoreForGHC92Plus :: String -> TestTree -> TestTree ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94]) -ignoreInWindowsForGHC88 :: TestTree -> TestTree -ignoreInWindowsForGHC88 = - ignoreFor (BrokenSpecific Windows [GHC88]) "tests are unreliable in windows for ghc 8.8" - knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) @@ -2455,7 +2451,7 @@ retryFailedCradle = testSession' "retry failed" $ \dir -> do dependentFileTest :: TestTree dependentFileTest = testGroup "addDependentFile" - [testGroup "file-changed" [ignoreInWindowsForGHC88 $ testSession' "test" test] + [testGroup "file-changed" [testSession' "test" test] ] where test dir = do diff --git a/ghcide/test/ghcide-test-utils.cabal b/ghcide/test/ghcide-test-utils.cabal index cccc5e35ac..3a180970c3 100644 --- a/ghcide/test/ghcide-test-utils.cabal +++ b/ghcide/test/ghcide-test-utils.cabal @@ -14,7 +14,7 @@ description: Test utils for ghcide homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme bug-reports: https://github.com/haskell/haskell-language-server/issues -tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 +tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 source-repository head type: git diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d44b072928..1a8bf32d38 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -14,7 +14,7 @@ copyright: The Haskell IDE Team license: Apache-2.0 license-file: LICENSE build-type: Simple -tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 +tested-with: GHC == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 extra-source-files: README.md ChangeLog.md @@ -251,7 +251,7 @@ common hlint cpp-options: -Dhls_hlint common stan - if flag(stan) && (impl(ghc >= 8.8) && impl(ghc < 9.0)) + if flag(stan) && (impl(ghc >= 8.10) && impl(ghc < 9.0)) build-depends: hls-stan-plugin ^>= 1.0 cpp-options: -Dhls_stan diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index 2a7c2d65d8..9cd4cc2f75 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -46,8 +46,6 @@ library Compat.HieDebug Compat.HieUtils - if (impl(ghc > 8.7) && impl(ghc < 8.10)) - hs-source-dirs: src-ghc88 src-reexport if (impl(ghc > 8.9) && impl(ghc < 8.11)) hs-source-dirs: src-ghc810 src-reexport if (impl(ghc >= 9.0) && impl(ghc < 9.1) || flag(ghc-lib)) diff --git a/hie-compat/src-ghc88/Compat/HieAst.hs b/hie-compat/src-ghc88/Compat/HieAst.hs deleted file mode 100644 index f1fab23db3..0000000000 --- a/hie-compat/src-ghc88/Compat/HieAst.hs +++ /dev/null @@ -1,1760 +0,0 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{- -Forked from GHC v8.8.1 to work around the readFile side effect in mkHiefile - -Main functions for .hie file generation --} -{- HLINT ignore -} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -module Compat.HieAst ( enrichHie ) where - -import Avail ( Avails ) -import Bag ( Bag, bagToList ) -import BasicTypes -import BooleanFormula -import Class ( FunDep ) -import CoreUtils ( exprType ) -import ConLike ( conLikeName ) -import Desugar ( deSugarExpr ) -import FieldLabel -import HsSyn -import HscTypes -import Module ( ModuleName, ml_hs_file ) -import MonadUtils ( concatMapM, liftIO ) -import Name ( Name, nameSrcSpan ) -import SrcLoc -import TcHsSyn ( hsLitType, hsPatType ) -import Type ( mkFunTys, Type ) -import TysWiredIn ( mkListTy, mkSumTy ) -import Var ( Id, Var, setVarName, varName, varType ) -import TcRnTypes -import MkIface ( mkIfaceExports ) - -import HieTypes -import HieUtils - -import qualified Data.Array as A -import qualified Data.ByteString as BS -import qualified Data.Map as M -import qualified Data.Set as S -import Data.Data ( Data, Typeable ) -import Data.List (foldl', foldl1' ) -import Data.Maybe ( listToMaybe ) -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Class ( lift ) - --- These synonyms match those defined in main/GHC.hs -type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn] - , Maybe [(LIE GhcRn, Avails)] - , Maybe LHsDocString ) -type TypecheckedSource = LHsBinds GhcTc - - -{- Note [Name Remapping] -The Typechecker introduces new names for mono names in AbsBinds. -We don't care about the distinction between mono and poly bindings, -so we replace all occurrences of the mono name with the poly name. --} -newtype HieState = HieState - { name_remapping :: M.Map Name Id - } - -initState :: HieState -initState = HieState M.empty - -class ModifyState a where -- See Note [Name Remapping] - addSubstitution :: a -> a -> HieState -> HieState - -instance ModifyState Name where - addSubstitution _ _ hs = hs - -instance ModifyState Id where - addSubstitution mono poly hs = - hs{name_remapping = M.insert (varName mono) poly (name_remapping hs)} - -modifyState :: ModifyState (IdP p) => [ABExport p] -> HieState -> HieState -modifyState = foldr go id - where - go ABE{abe_poly=poly,abe_mono=mono} f = addSubstitution mono poly . f - go _ f = f - -type HieM = ReaderT HieState Hsc - -enrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type) -enrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do - tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts - rasts <- processGrp hsGrp - imps <- toHie $ filter (not . ideclImplicit . unLoc) imports - exps <- toHie $ fmap (map $ IEC Export . fst) exports - let spanFile children = case children of - [] -> mkRealSrcSpan (mkRealSrcLoc "" 1 1) (mkRealSrcLoc "" 1 1) - _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children) - (realSrcSpanEnd $ nodeSpan $ last children) - - modulify xs = - Node (simpleNodeInfo "Module" "Module") (spanFile xs) xs - - asts = HieASTs - $ resolveTyVarScopes - $ M.map (modulify . mergeSortAsts) - $ M.fromListWith (++) - $ map (\x -> (srcSpanFile (nodeSpan x),[x])) flat_asts - - flat_asts = concat - [ tasts - , rasts - , imps - , exps - ] - return asts - where - processGrp grp = concatM - [ toHie $ fmap (RS ModuleScope ) hs_valds grp - , toHie $ hs_splcds grp - , toHie $ hs_tyclds grp - , toHie $ hs_derivds grp - , toHie $ hs_fixds grp - , toHie $ hs_defds grp - , toHie $ hs_fords grp - , toHie $ hs_warnds grp - , toHie $ hs_annds grp - , toHie $ hs_ruleds grp - ] - -getRealSpan :: SrcSpan -> Maybe Span -getRealSpan (RealSrcSpan sp) = Just sp -getRealSpan _ = Nothing - -grhss_span :: GRHSs p body -> SrcSpan -grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (getLoc bs) (map getLoc xs) -grhss_span (XGRHSs _) = error "XGRHS has no span" - -bindingsOnly :: [Context Name] -> [HieAST a] -bindingsOnly [] = [] -bindingsOnly (C c n : xs) = case nameSrcSpan n of - RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs - where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info) - info = mempty{identInfo = S.singleton c} - _ -> bindingsOnly xs - -concatM :: Monad m => [m [a]] -> m [a] -concatM xs = concat <$> sequence xs - -{- Note [Capturing Scopes and other non local information] -toHie is a local tranformation, but scopes of bindings cannot be known locally, -hence we have to push the relevant info down into the binding nodes. -We use the following types (*Context and *Scoped) to wrap things and -carry the required info -(Maybe Span) always carries the span of the entire binding, including rhs --} -data Context a = C ContextInfo a -- Used for names and bindings - -data RContext a = RC RecFieldContext a -data RFContext a = RFC RecFieldContext (Maybe Span) a --- ^ context for record fields - -data IEContext a = IEC IEType a --- ^ context for imports/exports - -data BindContext a = BC BindType Scope a --- ^ context for imports/exports - -data PatSynFieldContext a = PSC (Maybe Span) a --- ^ context for pattern synonym fields. - -data SigContext a = SC SigInfo a --- ^ context for type signatures - -data SigInfo = SI SigType (Maybe Span) - -data SigType = BindSig | ClassSig | InstSig - -data RScoped a = RS Scope a --- ^ Scope spans over everything to the right of a, (mostly) not --- including a itself --- (Includes a in a few special cases like recursive do bindings) or --- let/where bindings - --- | Pattern scope -data PScoped a = PS (Maybe Span) - Scope -- ^ use site of the pattern - Scope -- ^ pattern to the right of a, not including a - a - deriving (Typeable, Data) -- Pattern Scope - -{- Note [TyVar Scopes] -Due to -XScopedTypeVariables, type variables can be in scope quite far from -their original binding. We resolve the scope of these type variables -in a separate pass --} -data TScoped a = TS TyVarScope a -- TyVarScope - -data TVScoped a = TVS TyVarScope Scope a -- TyVarScope --- ^ First scope remains constant --- Second scope is used to build up the scope of a tyvar over --- things to its right, ala RScoped - --- | Each element scopes over the elements to the right -listScopes :: Scope -> [Located a] -> [RScoped (Located a)] -listScopes _ [] = [] -listScopes rhsScope [pat] = [RS rhsScope pat] -listScopes rhsScope (pat : pats) = RS sc pat : pats' - where - pats'@((RS scope p):_) = listScopes rhsScope pats - sc = combineScopes scope $ mkScope $ getLoc p - --- | 'listScopes' specialised to 'PScoped' things -patScopes - :: Maybe Span - -> Scope - -> Scope - -> [LPat (GhcPass p)] - -> [PScoped (LPat (GhcPass p))] -patScopes rsp useScope patScope xs = - map (\(RS sc a) -> PS rsp useScope sc (unLoc a)) $ - listScopes patScope (map dL xs) - --- | 'listScopes' specialised to 'TVScoped' things -tvScopes - :: TyVarScope - -> Scope - -> [LHsTyVarBndr a] - -> [TVScoped (LHsTyVarBndr a)] -tvScopes tvScope rhsScope xs = - map (\(RS sc a)-> TVS tvScope sc a) $ listScopes rhsScope xs - -{- Note [Scoping Rules for SigPat] -Explicitly quantified variables in pattern type signatures are not -brought into scope in the rhs, but implicitly quantified variables -are (HsWC and HsIB). -This is unlike other signatures, where explicitly quantified variables -are brought into the RHS Scope -For example -foo :: forall a. ...; -foo = ... -- a is in scope here - -bar (x :: forall a. a -> a) = ... -- a is not in scope here --- ^ a is in scope here (pattern body) - -bax (x :: a) = ... -- a is in scope here -Because of HsWC and HsIB pass on their scope to their children -we must wrap the LHsType in pattern signatures in a -Shielded explictly, so that the HsWC/HsIB scope is not passed -on the the LHsType --} - -data Shielded a = SH Scope a -- Ignores its TScope, uses its own scope instead - -type family ProtectedSig a where - ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs - GhcRn - (Shielded (LHsType GhcRn))) - ProtectedSig GhcTc = NoExt - -class ProtectSig a where - protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a - -instance (HasLoc a) => HasLoc (Shielded a) where - loc (SH _ a) = loc a - -instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where - toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a) - -instance ProtectSig GhcTc where - protectSig _ _ = NoExt - -instance ProtectSig GhcRn where - protectSig sc (HsWC a (HsIB b sig)) = - HsWC a (HsIB b (SH sc sig)) - protectSig _ _ = error "protectSig not given HsWC (HsIB)" - -class HasLoc a where - -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can - -- know what their implicit bindings are scoping over - loc :: a -> SrcSpan - -instance HasLoc thing => HasLoc (TScoped thing) where - loc (TS _ a) = loc a - -instance HasLoc thing => HasLoc (PScoped thing) where - loc (PS _ _ _ a) = loc a - -instance HasLoc (LHsQTyVars GhcRn) where - loc (HsQTvs _ vs) = loc vs - loc _ = noSrcSpan - -instance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where - loc (HsIB _ a) = loc a - loc _ = noSrcSpan - -instance HasLoc thing => HasLoc (HsWildCardBndrs a thing) where - loc (HsWC _ a) = loc a - loc _ = noSrcSpan - -instance HasLoc (Located a) where - loc (L l _) = l - -instance HasLoc a => HasLoc [a] where - loc [] = noSrcSpan - loc xs = foldl1' combineSrcSpans $ map loc xs - -instance (HasLoc a, HasLoc b) => HasLoc (FamEqn s a b) where - loc (FamEqn _ a Nothing b _ c) = foldl1' combineSrcSpans [loc a, loc b, loc c] - loc (FamEqn _ a (Just tvs) b _ c) = foldl1' combineSrcSpans - [loc a, loc tvs, loc b, loc c] - loc _ = noSrcSpan -instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where - loc (HsValArg tm) = loc tm - loc (HsTypeArg _ ty) = loc ty - loc (HsArgPar sp) = sp - -instance HasLoc (HsDataDefn GhcRn) where - loc def@(HsDataDefn{}) = loc $ dd_cons def - -- Only used for data family instances, so we only need rhs - -- Most probably the rest will be unhelpful anyway - loc _ = noSrcSpan - -instance HasLoc (Pat (GhcPass a)) where - loc (dL -> L l _) = l - --- | The main worker class -class ToHie a where - toHie :: a -> HieM [HieAST Type] - --- | Used to collect type info -class Data a => HasType a where - getTypeNode :: a -> HieM [HieAST Type] - -instance (ToHie a) => ToHie [a] where - toHie = concatMapM toHie - -instance (ToHie a) => ToHie (Bag a) where - toHie = toHie . bagToList - -instance (ToHie a) => ToHie (Maybe a) where - toHie = maybe (pure []) toHie - -instance ToHie (Context (Located NoExt)) where - toHie _ = pure [] - -instance ToHie (TScoped NoExt) where - toHie _ = pure [] - -instance ToHie (IEContext (Located ModuleName)) where - toHie (IEC c (L (RealSrcSpan span) mname)) = - pure $ [Node (NodeInfo S.empty [] idents) span []] - where details = mempty{identInfo = S.singleton (IEThing c)} - idents = M.singleton (Left mname) details - toHie _ = pure [] - -instance ToHie (Context (Located Var)) where - toHie c = case c of - C context (L (RealSrcSpan span) name') - -> do - m <- asks name_remapping - let name = M.findWithDefault name' (varName name') m - pure - [Node - (NodeInfo S.empty [] $ - M.singleton (Right $ varName name) - (IdentifierDetails (Just $ varType name') - (S.singleton context))) - span - []] - _ -> pure [] - -instance ToHie (Context (Located Name)) where - toHie c = case c of - C context (L (RealSrcSpan span) name') -> do - m <- asks name_remapping - let name = case M.lookup name' m of - Just var -> varName var - Nothing -> name' - pure - [Node - (NodeInfo S.empty [] $ - M.singleton (Right name) - (IdentifierDetails Nothing - (S.singleton context))) - span - []] - _ -> pure [] - --- | Dummy instances - never called -instance ToHie (TScoped (LHsSigWcType GhcTc)) where - toHie _ = pure [] -instance ToHie (TScoped (LHsWcType GhcTc)) where - toHie _ = pure [] -instance ToHie (SigContext (LSig GhcTc)) where - toHie _ = pure [] -instance ToHie (TScoped Type) where - toHie _ = pure [] - -instance HasType (LHsBind GhcRn) where - getTypeNode (L spn bind) = makeNode bind spn - -instance HasType (LHsBind GhcTc) where - getTypeNode (L spn bind) = case bind of - FunBind{fun_id = name} -> makeTypeNode bind spn (varType $ unLoc name) - _ -> makeNode bind spn - -instance HasType (LPat GhcRn) where - getTypeNode (dL -> L spn pat) = makeNode pat spn - -instance HasType (LPat GhcTc) where - getTypeNode (dL -> L spn opat) = makeTypeNode opat spn (hsPatType opat) - -instance HasType (LHsExpr GhcRn) where - getTypeNode (L spn e) = makeNode e spn - --- | This instance tries to construct 'HieAST' nodes which include the type of --- the expression. It is not yet possible to do this efficiently for all --- expression forms, so we skip filling in the type for those inputs. --- --- 'HsApp', for example, doesn't have any type information available directly on --- the node. Our next recourse would be to desugar it into a 'CoreExpr' then --- query the type of that. Yet both the desugaring call and the type query both --- involve recursive calls to the function and argument! This is particularly --- problematic when you realize that the HIE traversal will eventually visit --- those nodes too and ask for their types again. --- --- Since the above is quite costly, we just skip cases where computing the --- expression's type is going to be expensive. --- --- See #16233 -instance HasType (LHsExpr GhcTc) where - getTypeNode e@(L spn e') = lift $ - -- Some expression forms have their type immediately available - let tyOpt = case e' of - HsLit _ l -> Just (hsLitType l) - HsOverLit _ o -> Just (overLitType o) - - HsLam _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy) - HsLamCase _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy) - HsCase _ _ (MG { mg_ext = groupTy }) -> Just (mg_res_ty groupTy) - - ExplicitList ty _ _ -> Just (mkListTy ty) - ExplicitSum ty _ _ _ -> Just (mkSumTy ty) - HsDo ty _ _ -> Just ty - HsMultiIf ty _ -> Just ty - - _ -> Nothing - - in - case tyOpt of - _ | skipDesugaring e' -> fallback - | otherwise -> do - hs_env <- Hsc $ \e w -> return (e,w) - (_,mbe) <- liftIO $ deSugarExpr hs_env e - maybe fallback (makeTypeNode e' spn . exprType) mbe - where - fallback = makeNode e' spn - - matchGroupType :: MatchGroupTc -> Type - matchGroupType (MatchGroupTc args res) = mkFunTys args res - - -- | Skip desugaring of these expressions for performance reasons. - -- - -- See impact on Haddock output (esp. missing type annotations or links) - -- before marking more things here as 'False'. See impact on Haddock - -- performance before marking more things as 'True'. - skipDesugaring :: HsExpr a -> Bool - skipDesugaring e = case e of - HsVar{} -> False - HsUnboundVar{} -> False - HsConLikeOut{} -> False - HsRecFld{} -> False - HsOverLabel{} -> False - HsIPVar{} -> False - HsWrap{} -> False - _ -> True - -instance ( ToHie (Context (Located (IdP a))) - , ToHie (MatchGroup a (LHsExpr a)) - , ToHie (PScoped (LPat a)) - , ToHie (GRHSs a (LHsExpr a)) - , ToHie (LHsExpr a) - , ToHie (Located (PatSynBind a a)) - , HasType (LHsBind a) - , ModifyState (IdP a) - , Data (HsBind a) - ) => ToHie (BindContext (LHsBind a)) where - toHie (BC context scope b@(L span bind)) = - concatM $ getTypeNode b : case bind of - FunBind{fun_id = name, fun_matches = matches} -> - [ toHie $ C (ValBind context scope $ getRealSpan span) name - , toHie matches - ] - PatBind{pat_lhs = lhs, pat_rhs = rhs} -> - [ toHie $ PS (getRealSpan span) scope NoScope lhs - , toHie rhs - ] - VarBind{var_rhs = expr} -> - [ toHie expr - ] - AbsBinds{abs_exports = xs, abs_binds = binds} -> - [ local (modifyState xs) $ -- Note [Name Remapping] - toHie $ fmap (BC context scope) binds - ] - PatSynBind _ psb -> - [ toHie $ L span psb -- PatSynBinds only occur at the top level - ] - XHsBindsLR _ -> [] - -instance ( ToHie (LMatch a body) - ) => ToHie (MatchGroup a body) where - toHie mg = concatM $ case mg of - MG{ mg_alts = (L span alts) , mg_origin = FromSource } -> - [ pure $ locOnly span - , toHie alts - ] - MG{} -> [] - XMatchGroup _ -> [] - -instance ( ToHie (Context (Located (IdP a))) - , ToHie (PScoped (LPat a)) - , ToHie (HsPatSynDir a) - ) => ToHie (Located (PatSynBind a a)) where - toHie (L sp psb) = concatM $ case psb of - PSB{psb_id=var, psb_args=dets, psb_def=pat, psb_dir=dir} -> - [ toHie $ C (Decl PatSynDec $ getRealSpan sp) var - , toHie $ toBind dets - , toHie $ PS Nothing lhsScope NoScope pat - , toHie dir - ] - where - lhsScope = combineScopes varScope detScope - varScope = mkLScope var - detScope = case dets of - (PrefixCon args) -> foldr combineScopes NoScope $ map mkLScope args - (InfixCon a b) -> combineScopes (mkLScope a) (mkLScope b) - (RecCon r) -> foldr go NoScope r - go (RecordPatSynField a b) c = combineScopes c - $ combineScopes (mkLScope a) (mkLScope b) - detSpan = case detScope of - LocalScope a -> Just a - _ -> Nothing - toBind (PrefixCon args) = PrefixCon $ map (C Use) args - toBind (InfixCon a b) = InfixCon (C Use a) (C Use b) - toBind (RecCon r) = RecCon $ map (PSC detSpan) r - XPatSynBind _ -> [] - -instance ( ToHie (MatchGroup a (LHsExpr a)) - ) => ToHie (HsPatSynDir a) where - toHie dir = case dir of - ExplicitBidirectional mg -> toHie mg - _ -> pure [] - -instance ( a ~ GhcPass p - , ToHie body - , ToHie (HsMatchContext (NameOrRdrName (IdP a))) - , ToHie (PScoped (LPat a)) - , ToHie (GRHSs a body) - , Data (Match a body) - ) => ToHie (LMatch (GhcPass p) body) where - toHie (L span m ) = concatM $ makeNode m span : case m of - Match{m_ctxt=mctx, m_pats = pats, m_grhss = grhss } -> - [ toHie mctx - , let rhsScope = mkScope $ grhss_span grhss - in toHie $ patScopes Nothing rhsScope NoScope pats - , toHie grhss - ] - XMatch _ -> [] - -instance ( ToHie (Context (Located a)) - ) => ToHie (HsMatchContext a) where - toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name - toHie (StmtCtxt a) = toHie a - toHie _ = pure [] - -instance ( ToHie (HsMatchContext a) - ) => ToHie (HsStmtContext a) where - toHie (PatGuard a) = toHie a - toHie (ParStmtCtxt a) = toHie a - toHie (TransStmtCtxt a) = toHie a - toHie _ = pure [] - -instance ( a ~ GhcPass p - , ToHie (Context (Located (IdP a))) - , ToHie (RContext (HsRecFields a (PScoped (LPat a)))) - , ToHie (LHsExpr a) - , ToHie (TScoped (LHsSigWcType a)) - , ProtectSig a - , ToHie (TScoped (ProtectedSig a)) - , HasType (LPat a) - , Data (HsSplice a) - ) => ToHie (PScoped (LPat (GhcPass p))) where - toHie (PS rsp scope pscope lpat@(dL -> L ospan opat)) = - concatM $ getTypeNode lpat : case opat of - WildPat _ -> - [] - VarPat _ lname -> - [ toHie $ C (PatternBind scope pscope rsp) lname - ] - LazyPat _ p -> - [ toHie $ PS rsp scope pscope p - ] - AsPat _ lname pat -> - [ toHie $ C (PatternBind scope - (combineScopes (mkLScope (dL pat)) pscope) - rsp) - lname - , toHie $ PS rsp scope pscope pat - ] - ParPat _ pat -> - [ toHie $ PS rsp scope pscope pat - ] - BangPat _ pat -> - [ toHie $ PS rsp scope pscope pat - ] - ListPat _ pats -> - [ toHie $ patScopes rsp scope pscope pats - ] - TuplePat _ pats _ -> - [ toHie $ patScopes rsp scope pscope pats - ] - SumPat _ pat _ _ -> - [ toHie $ PS rsp scope pscope pat - ] - ConPatIn c dets -> - [ toHie $ C Use c - , toHie $ contextify dets - ] - ConPatOut {pat_con = con, pat_args = dets}-> - [ toHie $ C Use $ fmap conLikeName con - , toHie $ contextify dets - ] - ViewPat _ expr pat -> - [ toHie expr - , toHie $ PS rsp scope pscope pat - ] - SplicePat _ sp -> - [ toHie $ L ospan sp - ] - LitPat _ _ -> - [] - NPat _ _ _ _ -> - [] - NPlusKPat _ n _ _ _ _ -> - [ toHie $ C (PatternBind scope pscope rsp) n - ] - SigPat _ pat sig -> - [ toHie $ PS rsp scope pscope pat - , let cscope = mkLScope (dL pat) in - toHie $ TS (ResolvedScopes [cscope, scope, pscope]) - (protectSig @a cscope sig) - -- See Note [Scoping Rules for SigPat] - ] - CoPat _ _ _ _ -> - [] - XPat _ -> [] - where - contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args - contextify (InfixCon a b) = InfixCon a' b' - where [a', b'] = patScopes rsp scope pscope [a,b] - contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r - contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a - where - go (RS fscope (L spn (HsRecField lbl pat pun))) = - L spn $ HsRecField lbl (PS rsp scope fscope pat) pun - scoped_fds = listScopes pscope fds - -instance ( ToHie body - , ToHie (LGRHS a body) - , ToHie (RScoped (LHsLocalBinds a)) - ) => ToHie (GRHSs a body) where - toHie grhs = concatM $ case grhs of - GRHSs _ grhss binds -> - [ toHie grhss - , toHie $ RS (mkScope $ grhss_span grhs) binds - ] - XGRHSs _ -> [] - -instance ( ToHie (Located body) - , ToHie (RScoped (GuardLStmt a)) - , Data (GRHS a (Located body)) - ) => ToHie (LGRHS a (Located body)) where - toHie (L span g) = concatM $ makeNode g span : case g of - GRHS _ guards body -> - [ toHie $ listScopes (mkLScope body) guards - , toHie body - ] - XGRHS _ -> [] - -instance ( a ~ GhcPass p - , ToHie (Context (Located (IdP a))) - , HasType (LHsExpr a) - , ToHie (PScoped (LPat a)) - , ToHie (MatchGroup a (LHsExpr a)) - , ToHie (LGRHS a (LHsExpr a)) - , ToHie (RContext (HsRecordBinds a)) - , ToHie (RFContext (Located (AmbiguousFieldOcc a))) - , ToHie (ArithSeqInfo a) - , ToHie (LHsCmdTop a) - , ToHie (RScoped (GuardLStmt a)) - , ToHie (RScoped (LHsLocalBinds a)) - , ToHie (TScoped (LHsWcType (NoGhcTc a))) - , ToHie (TScoped (LHsSigWcType (NoGhcTc a))) - , Data (HsExpr a) - , Data (HsSplice a) - , Data (HsTupArg a) - , Data (AmbiguousFieldOcc a) - ) => ToHie (LHsExpr (GhcPass p)) where - toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of - HsVar _ (L _ var) -> - [ toHie $ C Use (L mspan var) - -- Patch up var location since typechecker removes it - ] - HsUnboundVar _ _ -> - [] - HsConLikeOut _ con -> - [ toHie $ C Use $ L mspan $ conLikeName con - ] - HsRecFld _ fld -> - [ toHie $ RFC RecFieldOcc Nothing (L mspan fld) - ] - HsOverLabel _ _ _ -> [] - HsIPVar _ _ -> [] - HsOverLit _ _ -> [] - HsLit _ _ -> [] - HsLam _ mg -> - [ toHie mg - ] - HsLamCase _ mg -> - [ toHie mg - ] - HsApp _ a b -> - [ toHie a - , toHie b - ] - HsAppType _ expr sig -> - [ toHie expr - , toHie $ TS (ResolvedScopes []) sig - ] - OpApp _ a b c -> - [ toHie a - , toHie b - , toHie c - ] - NegApp _ a _ -> - [ toHie a - ] - HsPar _ a -> - [ toHie a - ] - SectionL _ a b -> - [ toHie a - , toHie b - ] - SectionR _ a b -> - [ toHie a - , toHie b - ] - ExplicitTuple _ args _ -> - [ toHie args - ] - ExplicitSum _ _ _ expr -> - [ toHie expr - ] - HsCase _ expr matches -> - [ toHie expr - , toHie matches - ] - HsIf _ _ a b c -> - [ toHie a - , toHie b - , toHie c - ] - HsMultiIf _ grhss -> - [ toHie grhss - ] - HsLet _ binds expr -> - [ toHie $ RS (mkLScope expr) binds - , toHie expr - ] - HsDo _ _ (L ispan stmts) -> - [ pure $ locOnly ispan - , toHie $ listScopes NoScope stmts - ] - ExplicitList _ _ exprs -> - [ toHie exprs - ] - RecordCon {rcon_con_name = name, rcon_flds = binds}-> - [ toHie $ C Use name - , toHie $ RC RecFieldAssign $ binds - ] - RecordUpd {rupd_expr = expr, rupd_flds = upds}-> - [ toHie expr - , toHie $ map (RC RecFieldAssign) upds - ] - ExprWithTySig _ expr sig -> - [ toHie expr - , toHie $ TS (ResolvedScopes [mkLScope expr]) sig - ] - ArithSeq _ _ info -> - [ toHie info - ] - HsSCC _ _ _ expr -> - [ toHie expr - ] - HsCoreAnn _ _ _ expr -> - [ toHie expr - ] - HsProc _ pat cmdtop -> - [ toHie $ PS Nothing (mkLScope cmdtop) NoScope pat - , toHie cmdtop - ] - HsStatic _ expr -> - [ toHie expr - ] - HsArrApp _ a b _ _ -> - [ toHie a - , toHie b - ] - HsArrForm _ expr _ cmds -> - [ toHie expr - , toHie cmds - ] - HsTick _ _ expr -> - [ toHie expr - ] - HsBinTick _ _ _ expr -> - [ toHie expr - ] - HsTickPragma _ _ _ _ expr -> - [ toHie expr - ] - HsWrap _ _ a -> - [ toHie $ L mspan a - ] - HsBracket _ b -> - [ toHie b - ] - HsRnBracketOut _ b p -> - [ toHie b - , toHie p - ] - HsTcBracketOut _ b p -> - [ toHie b - , toHie p - ] - HsSpliceE _ x -> - [ toHie $ L mspan x - ] - EWildPat _ -> [] - EAsPat _ a b -> - [ toHie $ C Use a - , toHie b - ] - EViewPat _ a b -> - [ toHie a - , toHie b - ] - ELazyPat _ a -> - [ toHie a - ] - XExpr _ -> [] - -instance ( a ~ GhcPass p - , ToHie (LHsExpr a) - , Data (HsTupArg a) - ) => ToHie (LHsTupArg (GhcPass p)) where - toHie (L span arg) = concatM $ makeNode arg span : case arg of - Present _ expr -> - [ toHie expr - ] - Missing _ -> [] - XTupArg _ -> [] - -instance ( a ~ GhcPass p - , ToHie (PScoped (LPat a)) - , ToHie (LHsExpr a) - , ToHie (SigContext (LSig a)) - , ToHie (RScoped (LHsLocalBinds a)) - , ToHie (RScoped (ApplicativeArg a)) - , ToHie (Located body) - , Data (StmtLR a a (Located body)) - , Data (StmtLR a a (Located (HsExpr a))) - ) => ToHie (RScoped (LStmt (GhcPass p) (Located body))) where - toHie (RS scope (L span stmt)) = concatM $ makeNode stmt span : case stmt of - LastStmt _ body _ _ -> - [ toHie body - ] - BindStmt _ pat body _ _ -> - [ toHie $ PS (getRealSpan $ getLoc body) scope NoScope pat - , toHie body - ] - ApplicativeStmt _ stmts _ -> - [ concatMapM (toHie . RS scope . snd) stmts - ] - BodyStmt _ body _ _ -> - [ toHie body - ] - LetStmt _ binds -> - [ toHie $ RS scope binds - ] - ParStmt _ parstmts _ _ -> - [ concatMapM (\(ParStmtBlock _ stmts _ _) -> - toHie $ listScopes NoScope stmts) - parstmts - ] - TransStmt {trS_stmts = stmts, trS_using = using, trS_by = by} -> - [ toHie $ listScopes scope stmts - , toHie using - , toHie by - ] - RecStmt {recS_stmts = stmts} -> - [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts - ] - XStmtLR _ -> [] - -instance ( ToHie (LHsExpr a) - , ToHie (PScoped (LPat a)) - , ToHie (BindContext (LHsBind a)) - , ToHie (SigContext (LSig a)) - , ToHie (RScoped (HsValBindsLR a a)) - , Data (HsLocalBinds a) - ) => ToHie (RScoped (LHsLocalBinds a)) where - toHie (RS scope (L sp binds)) = concatM $ makeNode binds sp : case binds of - EmptyLocalBinds _ -> [] - HsIPBinds _ _ -> [] - HsValBinds _ valBinds -> - [ toHie $ RS (combineScopes scope $ mkScope sp) - valBinds - ] - XHsLocalBindsLR _ -> [] - -instance ( ToHie (BindContext (LHsBind a)) - , ToHie (SigContext (LSig a)) - , ToHie (RScoped (XXValBindsLR a a)) - ) => ToHie (RScoped (HsValBindsLR a a)) where - toHie (RS sc v) = concatM $ case v of - ValBinds _ binds sigs -> - [ toHie $ fmap (BC RegularBind sc) binds - , toHie $ fmap (SC (SI BindSig Nothing)) sigs - ] - XValBindsLR x -> [ toHie $ RS sc x ] - -instance ToHie (RScoped (NHsValBindsLR GhcTc)) where - toHie (RS sc (NValBinds binds sigs)) = concatM $ - [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds) - , toHie $ fmap (SC (SI BindSig Nothing)) sigs - ] -instance ToHie (RScoped (NHsValBindsLR GhcRn)) where - toHie (RS sc (NValBinds binds sigs)) = concatM $ - [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds) - , toHie $ fmap (SC (SI BindSig Nothing)) sigs - ] - -instance ( ToHie (RContext (LHsRecField a arg)) - ) => ToHie (RContext (HsRecFields a arg)) where - toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields - -instance ( ToHie (RFContext (Located label)) - , ToHie arg - , HasLoc arg - , Data label - , Data arg - ) => ToHie (RContext (LHsRecField' label arg)) where - toHie (RC c (L span recfld)) = concatM $ makeNode recfld span : case recfld of - HsRecField label expr _ -> - [ toHie $ RFC c (getRealSpan $ loc expr) label - , toHie expr - ] - -instance ToHie (RFContext (LFieldOcc GhcRn)) where - toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan name) - ] - XFieldOcc _ -> [] - -instance ToHie (RFContext (LFieldOcc GhcTc)) where - toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc var _ -> - let var' = setVarName var (varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] - XFieldOcc _ -> [] - -instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where - toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of - Unambiguous name _ -> - [ toHie $ C (RecField c rhs) $ L nspan name - ] - Ambiguous _name _ -> - [ ] - XAmbiguousFieldOcc _ -> [] - -instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where - toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of - Unambiguous var _ -> - let var' = setVarName var (varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] - Ambiguous var _ -> - let var' = setVarName var (varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] - XAmbiguousFieldOcc _ -> [] - -instance ( a ~ GhcPass p - , ToHie (PScoped (LPat a)) - , ToHie (BindContext (LHsBind a)) - , ToHie (LHsExpr a) - , ToHie (SigContext (LSig a)) - , ToHie (RScoped (HsValBindsLR a a)) - , Data (StmtLR a a (Located (HsExpr a))) - , Data (HsLocalBinds a) - ) => ToHie (RScoped (ApplicativeArg (GhcPass p))) where - toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM - [ toHie $ PS Nothing sc NoScope pat - , toHie expr - ] - toHie (RS sc (ApplicativeArgMany _ stmts _ pat)) = concatM - [ toHie $ listScopes NoScope stmts - , toHie $ PS Nothing sc NoScope pat - ] - toHie (RS _ (XApplicativeArg _)) = pure [] - -instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where - toHie (PrefixCon args) = toHie args - toHie (RecCon rec) = toHie rec - toHie (InfixCon a b) = concatM [ toHie a, toHie b] - -instance ( ToHie (LHsCmd a) - , Data (HsCmdTop a) - ) => ToHie (LHsCmdTop a) where - toHie (L span top) = concatM $ makeNode top span : case top of - HsCmdTop _ cmd -> - [ toHie cmd - ] - XCmdTop _ -> [] - -instance ( a ~ GhcPass p - , ToHie (PScoped (LPat a)) - , ToHie (BindContext (LHsBind a)) - , ToHie (LHsExpr a) - , ToHie (MatchGroup a (LHsCmd a)) - , ToHie (SigContext (LSig a)) - , ToHie (RScoped (HsValBindsLR a a)) - , Data (HsCmd a) - , Data (HsCmdTop a) - , Data (StmtLR a a (Located (HsCmd a))) - , Data (HsLocalBinds a) - , Data (StmtLR a a (Located (HsExpr a))) - ) => ToHie (LHsCmd (GhcPass p)) where - toHie (L span cmd) = concatM $ makeNode cmd span : case cmd of - HsCmdArrApp _ a b _ _ -> - [ toHie a - , toHie b - ] - HsCmdArrForm _ a _ _ cmdtops -> - [ toHie a - , toHie cmdtops - ] - HsCmdApp _ a b -> - [ toHie a - , toHie b - ] - HsCmdLam _ mg -> - [ toHie mg - ] - HsCmdPar _ a -> - [ toHie a - ] - HsCmdCase _ expr alts -> - [ toHie expr - , toHie alts - ] - HsCmdIf _ _ a b c -> - [ toHie a - , toHie b - , toHie c - ] - HsCmdLet _ binds cmd' -> - [ toHie $ RS (mkLScope cmd') binds - , toHie cmd' - ] - HsCmdDo _ (L ispan stmts) -> - [ pure $ locOnly ispan - , toHie $ listScopes NoScope stmts - ] - HsCmdWrap _ _ _ -> [] - XCmd _ -> [] - -instance ToHie (TyClGroup GhcRn) where - toHie (TyClGroup _ classes roles instances) = concatM - [ toHie classes - , toHie roles - , toHie instances - ] - toHie (XTyClGroup _) = pure [] - -instance ToHie (LTyClDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - FamDecl {tcdFam = fdecl} -> - [ toHie (L span fdecl) - ] - SynDecl {tcdLName = name, tcdTyVars = vars, tcdRhs = typ} -> - [ toHie $ C (Decl SynDec $ getRealSpan span) name - , toHie $ TS (ResolvedScopes [mkScope $ getLoc typ]) vars - , toHie typ - ] - DataDecl {tcdLName = name, tcdTyVars = vars, tcdDataDefn = defn} -> - [ toHie $ C (Decl DataDec $ getRealSpan span) name - , toHie $ TS (ResolvedScopes [quant_scope, rhs_scope]) vars - , toHie defn - ] - where - quant_scope = mkLScope $ dd_ctxt defn - rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc - sig_sc = maybe NoScope mkLScope $ dd_kindSig defn - con_sc = foldr combineScopes NoScope $ map mkLScope $ dd_cons defn - deriv_sc = mkLScope $ dd_derivs defn - ClassDecl { tcdCtxt = context - , tcdLName = name - , tcdTyVars = vars - , tcdFDs = deps - , tcdSigs = sigs - , tcdMeths = meths - , tcdATs = typs - , tcdATDefs = deftyps - } -> - [ toHie $ C (Decl ClassDec $ getRealSpan span) name - , toHie context - , toHie $ TS (ResolvedScopes [context_scope, rhs_scope]) vars - , toHie deps - , toHie $ map (SC $ SI ClassSig $ getRealSpan span) sigs - , toHie $ fmap (BC InstanceBind ModuleScope) meths - , toHie typs - , concatMapM (pure . locOnly . getLoc) deftyps - , toHie $ map (go . unLoc) deftyps - ] - where - context_scope = mkLScope context - rhs_scope = foldl1' combineScopes $ map mkScope - [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] - - go :: TyFamDefltEqn GhcRn - -> FamEqn GhcRn (TScoped (LHsQTyVars GhcRn)) (LHsType GhcRn) - go (FamEqn a var bndrs pat b rhs) = - FamEqn a var bndrs (TS (ResolvedScopes [mkLScope rhs]) pat) b rhs - go (XFamEqn NoExt) = XFamEqn NoExt - XTyClDecl _ -> [] - -instance ToHie (LFamilyDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - FamilyDecl _ info name vars _ sig inj -> - [ toHie $ C (Decl FamDec $ getRealSpan span) name - , toHie $ TS (ResolvedScopes [rhsSpan]) vars - , toHie info - , toHie $ RS injSpan sig - , toHie inj - ] - where - rhsSpan = sigSpan `combineScopes` injSpan - sigSpan = mkScope $ getLoc sig - injSpan = maybe NoScope (mkScope . getLoc) inj - XFamilyDecl _ -> [] - -instance ToHie (FamilyInfo GhcRn) where - toHie (ClosedTypeFamily (Just eqns)) = concatM $ - [ concatMapM (pure . locOnly . getLoc) eqns - , toHie $ map go eqns - ] - where - go (L l ib) = TS (ResolvedScopes [mkScope l]) ib - toHie _ = pure [] - -instance ToHie (RScoped (LFamilyResultSig GhcRn)) where - toHie (RS sc (L span sig)) = concatM $ makeNode sig span : case sig of - NoSig _ -> - [] - KindSig _ k -> - [ toHie k - ] - TyVarSig _ bndr -> - [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr - ] - XFamilyResultSig _ -> [] - -instance ToHie (Located (FunDep (Located Name))) where - toHie (L span fd@(lhs, rhs)) = concatM $ - [ makeNode fd span - , toHie $ map (C Use) lhs - , toHie $ map (C Use) rhs - ] - -instance (ToHie pats, ToHie rhs, HasLoc pats, HasLoc rhs) - => ToHie (TScoped (FamEqn GhcRn pats rhs)) where - toHie (TS _ f) = toHie f - -instance ( ToHie pats - , ToHie rhs - , HasLoc pats - , HasLoc rhs - ) => ToHie (FamEqn GhcRn pats rhs) where - toHie fe@(FamEqn _ var tybndrs pats _ rhs) = concatM $ - [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var - , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs - , toHie pats - , toHie rhs - ] - where scope = combineScopes patsScope rhsScope - patsScope = mkScope (loc pats) - rhsScope = mkScope (loc rhs) - toHie (XFamEqn _) = pure [] - -instance ToHie (LInjectivityAnn GhcRn) where - toHie (L span ann) = concatM $ makeNode ann span : case ann of - InjectivityAnn lhs rhs -> - [ toHie $ C Use lhs - , toHie $ map (C Use) rhs - ] - -instance ToHie (HsDataDefn GhcRn) where - toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM - [ toHie ctx - , toHie mkind - , toHie cons - , toHie derivs - ] - toHie (XHsDataDefn _) = pure [] - -instance ToHie (HsDeriving GhcRn) where - toHie (L span clauses) = concatM - [ pure $ locOnly span - , toHie clauses - ] - -instance ToHie (LHsDerivingClause GhcRn) where - toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat (L ispan tys) -> - [ toHie strat - , pure $ locOnly ispan - , toHie $ map (TS (ResolvedScopes [])) tys - ] - XHsDerivingClause _ -> [] - -instance ToHie (Located (DerivStrategy GhcRn)) where - toHie (L span strat) = concatM $ makeNode strat span : case strat of - StockStrategy -> [] - AnyclassStrategy -> [] - NewtypeStrategy -> [] - ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ] - -instance ToHie (Located OverlapMode) where - toHie (L span _) = pure $ locOnly span - -instance ToHie (LConDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - ConDeclGADT { con_names = names, con_qvars = qvars - , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } -> - [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names - , toHie $ TS (ResolvedScopes [ctxScope, rhsScope]) qvars - , toHie ctx - , toHie args - , toHie typ - ] - where - rhsScope = combineScopes argsScope tyScope - ctxScope = maybe NoScope mkLScope ctx - argsScope = condecl_scope args - tyScope = mkLScope typ - ConDeclH98 { con_name = name, con_ex_tvs = qvars - , con_mb_cxt = ctx, con_args = dets } -> - [ toHie $ C (Decl ConDec $ getRealSpan span) name - , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars - , toHie ctx - , toHie dets - ] - where - rhsScope = combineScopes ctxScope argsScope - ctxScope = maybe NoScope mkLScope ctx - argsScope = condecl_scope dets - XConDecl _ -> [] - where condecl_scope args = case args of - PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs - InfixCon a b -> combineScopes (mkLScope a) (mkLScope b) - RecCon x -> mkLScope x - -instance ToHie (Located [LConDeclField GhcRn]) where - toHie (L span decls) = concatM $ - [ pure $ locOnly span - , toHie decls - ] - -instance ( HasLoc thing - , ToHie (TScoped thing) - ) => ToHie (TScoped (HsImplicitBndrs GhcRn thing)) where - toHie (TS sc (HsIB ibrn a)) = concatM $ - [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) ibrn - , toHie $ TS sc a - ] - where span = loc a - toHie (TS _ (XHsImplicitBndrs _)) = pure [] - -instance ( HasLoc thing - , ToHie (TScoped thing) - ) => ToHie (TScoped (HsWildCardBndrs GhcRn thing)) where - toHie (TS sc (HsWC names a)) = concatM $ - [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names - , toHie $ TS sc a - ] - where span = loc a - toHie (TS _ (XHsWildCardBndrs _)) = pure [] - -instance ToHie (SigContext (LSig GhcRn)) where - toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of - TypeSig _ names typ -> - [ toHie $ map (C TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ - ] - PatSynSig _ names typ -> - [ toHie $ map (C TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ - ] - ClassOpSig _ _ names typ -> - [ case styp of - ClassSig -> toHie $ map (C $ ClassTyDecl $ getRealSpan sp) names - _ -> toHie $ map (C $ TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ - ] - IdSig _ _ -> [] - FixSig _ fsig -> - [ toHie $ L sp fsig - ] - InlineSig _ name _ -> - [ toHie $ (C Use) name - ] - SpecSig _ name typs _ -> - [ toHie $ (C Use) name - , toHie $ map (TS (ResolvedScopes [])) typs - ] - SpecInstSig _ _ typ -> - [ toHie $ TS (ResolvedScopes []) typ - ] - MinimalSig _ _ form -> - [ toHie form - ] - SCCFunSig _ _ name mtxt -> - [ toHie $ (C Use) name - , pure $ maybe [] (locOnly . getLoc) mtxt - ] - CompleteMatchSig _ _ (L ispan names) typ -> - [ pure $ locOnly ispan - , toHie $ map (C Use) names - , toHie $ fmap (C Use) typ - ] - XSig _ -> [] - -instance ToHie (LHsType GhcRn) where - toHie x = toHie $ TS (ResolvedScopes []) x - -instance ToHie (TScoped (LHsType GhcRn)) where - toHie (TS tsc (L span t)) = concatM $ makeNode t span : case t of - HsForAllTy _ bndrs body -> - [ toHie $ tvScopes tsc (mkScope $ getLoc body) bndrs - , toHie body - ] - HsQualTy _ ctx body -> - [ toHie ctx - , toHie body - ] - HsTyVar _ _ var -> - [ toHie $ C Use var - ] - HsAppTy _ a b -> - [ toHie a - , toHie b - ] - HsAppKindTy _ ty ki -> - [ toHie ty - , toHie $ TS (ResolvedScopes []) ki - ] - HsFunTy _ a b -> - [ toHie a - , toHie b - ] - HsListTy _ a -> - [ toHie a - ] - HsTupleTy _ _ tys -> - [ toHie tys - ] - HsSumTy _ tys -> - [ toHie tys - ] - HsOpTy _ a op b -> - [ toHie a - , toHie $ C Use op - , toHie b - ] - HsParTy _ a -> - [ toHie a - ] - HsIParamTy _ ip ty -> - [ toHie ip - , toHie ty - ] - HsKindSig _ a b -> - [ toHie a - , toHie b - ] - HsSpliceTy _ a -> - [ toHie $ L span a - ] - HsDocTy _ a _ -> - [ toHie a - ] - HsBangTy _ _ ty -> - [ toHie ty - ] - HsRecTy _ fields -> - [ toHie fields - ] - HsExplicitListTy _ _ tys -> - [ toHie tys - ] - HsExplicitTupleTy _ tys -> - [ toHie tys - ] - HsTyLit _ _ -> [] - HsWildCardTy _ -> [] - HsStarTy _ _ -> [] - XHsType _ -> [] - -instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where - toHie (HsValArg tm) = toHie tm - toHie (HsTypeArg _ ty) = toHie ty - toHie (HsArgPar sp) = pure $ locOnly sp - -instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where - toHie (TVS tsc sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of - UserTyVar _ var -> - [ toHie $ C (TyVarBind sc tsc) var - ] - KindedTyVar _ var kind -> - [ toHie $ C (TyVarBind sc tsc) var - , toHie kind - ] - XTyVarBndr _ -> [] - -instance ToHie (TScoped (LHsQTyVars GhcRn)) where - toHie (TS sc (HsQTvs (HsQTvsRn implicits _) vars)) = concatM $ - [ pure $ bindingsOnly bindings - , toHie $ tvScopes sc NoScope vars - ] - where - varLoc = loc vars - bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits - toHie (TS _ (XLHsQTyVars _)) = pure [] - -instance ToHie (LHsContext GhcRn) where - toHie (L span tys) = concatM $ - [ pure $ locOnly span - , toHie tys - ] - -instance ToHie (LConDeclField GhcRn) where - toHie (L span field) = concatM $ makeNode field span : case field of - ConDeclField _ fields typ _ -> - [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields - , toHie typ - ] - XConDeclField _ -> [] - -instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where - toHie (From expr) = toHie expr - toHie (FromThen a b) = concatM $ - [ toHie a - , toHie b - ] - toHie (FromTo a b) = concatM $ - [ toHie a - , toHie b - ] - toHie (FromThenTo a b c) = concatM $ - [ toHie a - , toHie b - , toHie c - ] - -instance ToHie (LSpliceDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - SpliceDecl _ splice _ -> - [ toHie splice - ] - XSpliceDecl _ -> [] - -instance ToHie (HsBracket a) where - toHie _ = pure [] - -instance ToHie PendingRnSplice where - toHie _ = pure [] - -instance ToHie PendingTcSplice where - toHie _ = pure [] - -instance ToHie (LBooleanFormula (Located Name)) where - toHie (L span form) = concatM $ makeNode form span : case form of - Var a -> - [ toHie $ C Use a - ] - And forms -> - [ toHie forms - ] - Or forms -> - [ toHie forms - ] - Parens f -> - [ toHie f - ] - -instance ToHie (Located HsIPName) where - toHie (L span e) = makeNode e span - -instance ( ToHie (LHsExpr a) - , Data (HsSplice a) - ) => ToHie (Located (HsSplice a)) where - toHie (L span sp) = concatM $ makeNode sp span : case sp of - HsTypedSplice _ _ _ expr -> - [ toHie expr - ] - HsUntypedSplice _ _ _ expr -> - [ toHie expr - ] - HsQuasiQuote _ _ _ ispan _ -> - [ pure $ locOnly ispan - ] - HsSpliced _ _ _ -> - [] - HsSplicedT _ -> - [] - XSplice _ -> [] - -instance ToHie (LRoleAnnotDecl GhcRn) where - toHie (L span annot) = concatM $ makeNode annot span : case annot of - RoleAnnotDecl _ var roles -> - [ toHie $ C Use var - , concatMapM (pure . locOnly . getLoc) roles - ] - XRoleAnnotDecl _ -> [] - -instance ToHie (LInstDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - ClsInstD _ d -> - [ toHie $ L span d - ] - DataFamInstD _ d -> - [ toHie $ L span d - ] - TyFamInstD _ d -> - [ toHie $ L span d - ] - XInstDecl _ -> [] - -instance ToHie (LClsInstDecl GhcRn) where - toHie (L span decl) = concatM - [ toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl - , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl - , toHie $ map (SC $ SI InstSig $ getRealSpan span) $ cid_sigs decl - , pure $ concatMap (locOnly . getLoc) $ cid_tyfam_insts decl - , toHie $ cid_tyfam_insts decl - , pure $ concatMap (locOnly . getLoc) $ cid_datafam_insts decl - , toHie $ cid_datafam_insts decl - , toHie $ cid_overlap_mode decl - ] - -instance ToHie (LDataFamInstDecl GhcRn) where - toHie (L sp (DataFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d - -instance ToHie (LTyFamInstDecl GhcRn) where - toHie (L sp (TyFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d - -instance ToHie (Context a) - => ToHie (PatSynFieldContext (RecordPatSynField a)) where - toHie (PSC sp (RecordPatSynField a b)) = concatM $ - [ toHie $ C (RecField RecFieldDecl sp) a - , toHie $ C Use b - ] - -instance ToHie (LDerivDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - DerivDecl _ typ strat overlap -> - [ toHie $ TS (ResolvedScopes []) typ - , toHie strat - , toHie overlap - ] - XDerivDecl _ -> [] - -instance ToHie (LFixitySig GhcRn) where - toHie (L span sig) = concatM $ makeNode sig span : case sig of - FixitySig _ vars _ -> - [ toHie $ map (C Use) vars - ] - XFixitySig _ -> [] - -instance ToHie (LDefaultDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - DefaultDecl _ typs -> - [ toHie typs - ] - XDefaultDecl _ -> [] - -instance ToHie (LForeignDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - ForeignImport {fd_name = name, fd_sig_ty = sig, fd_fi = fi} -> - [ toHie $ C (ValBind RegularBind ModuleScope $ getRealSpan span) name - , toHie $ TS (ResolvedScopes []) sig - , toHie fi - ] - ForeignExport {fd_name = name, fd_sig_ty = sig, fd_fe = fe} -> - [ toHie $ C Use name - , toHie $ TS (ResolvedScopes []) sig - , toHie fe - ] - XForeignDecl _ -> [] - -instance ToHie ForeignImport where - toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $ - [ locOnly a - , locOnly b - , locOnly c - ] - -instance ToHie ForeignExport where - toHie (CExport (L a _) (L b _)) = pure $ concat $ - [ locOnly a - , locOnly b - ] - -instance ToHie (LWarnDecls GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - Warnings _ _ warnings -> - [ toHie warnings - ] - XWarnDecls _ -> [] - -instance ToHie (LWarnDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - Warning _ vars _ -> - [ toHie $ map (C Use) vars - ] - XWarnDecl _ -> [] - -instance ToHie (LAnnDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - HsAnnotation _ _ prov expr -> - [ toHie prov - , toHie expr - ] - XAnnDecl _ -> [] - -instance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where - toHie (ValueAnnProvenance a) = toHie $ C Use a - toHie (TypeAnnProvenance a) = toHie $ C Use a - toHie ModuleAnnProvenance = pure [] - -instance ToHie (LRuleDecls GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - HsRules _ _ rules -> - [ toHie rules - ] - XRuleDecls _ -> [] - -instance ToHie (LRuleDecl GhcRn) where - toHie (L _ (XRuleDecl _)) = pure [] - toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM - [ makeNode r span - , pure $ locOnly $ getLoc rname - , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs - , toHie $ map (RS $ mkScope span) bndrs - , toHie exprA - , toHie exprB - ] - where scope = bndrs_sc `combineScopes` exprA_sc `combineScopes` exprB_sc - bndrs_sc = maybe NoScope mkLScope (listToMaybe bndrs) - exprA_sc = mkLScope exprA - exprB_sc = mkLScope exprB - -instance ToHie (RScoped (LRuleBndr GhcRn)) where - toHie (RS sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of - RuleBndr _ var -> - [ toHie $ C (ValBind RegularBind sc Nothing) var - ] - RuleBndrSig _ var typ -> - [ toHie $ C (ValBind RegularBind sc Nothing) var - , toHie $ TS (ResolvedScopes [sc]) typ - ] - XRuleBndr _ -> [] - -instance ToHie (LImportDecl GhcRn) where - toHie (L span decl) = concatM $ makeNode decl span : case decl of - ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } -> - [ toHie $ IEC Import name - , toHie $ fmap (IEC ImportAs) as - , maybe (pure []) goIE hidden - ] - XImportDecl _ -> [] - where - goIE (hiding, (L sp liens)) = concatM $ - [ pure $ locOnly sp - , toHie $ map (IEC c) liens - ] - where - c = if hiding then ImportHiding else Import - -instance ToHie (IEContext (LIE GhcRn)) where - toHie (IEC c (L span ie)) = concatM $ makeNode ie span : case ie of - IEVar _ n -> - [ toHie $ IEC c n - ] - IEThingAbs _ n -> - [ toHie $ IEC c n - ] - IEThingAll _ n -> - [ toHie $ IEC c n - ] - IEThingWith _ n _ ns flds -> - [ toHie $ IEC c n - , toHie $ map (IEC c) ns - , toHie $ map (IEC c) flds - ] - IEModuleContents _ n -> - [ toHie $ IEC c n - ] - IEGroup _ _ _ -> [] - IEDoc _ _ -> [] - IEDocNamed _ _ -> [] - XIE _ -> [] - -instance ToHie (IEContext (LIEWrappedName Name)) where - toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of - IEName n -> - [ toHie $ C (IEThing c) n - ] - IEPattern p -> - [ toHie $ C (IEThing c) p - ] - IEType n -> - [ toHie $ C (IEThing c) n - ] - -instance ToHie (IEContext (Located (FieldLbl Name))) where - toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of - FieldLabel _ _ n -> - [ toHie $ C (IEThing c) $ L span n - ] - diff --git a/hie-compat/src-ghc88/Compat/HieBin.hs b/hie-compat/src-ghc88/Compat/HieBin.hs deleted file mode 100644 index 859fc0f07d..0000000000 --- a/hie-compat/src-ghc88/Compat/HieBin.hs +++ /dev/null @@ -1,389 +0,0 @@ -{- -Binary serialization for .hie files. --} -{- HLINT ignore -} -{-# LANGUAGE ScopedTypeVariables #-} -module Compat.HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic,NameCacheUpdater(..)) where - -import Config ( cProjectVersion ) -import Binary -import BinIface ( getDictFastString ) -import FastMutInt -import FastString ( FastString ) -import Module ( Module ) -import Name -import NameCache -import Outputable -import PrelInfo -import SrcLoc -import UniqSupply ( takeUniqFromSupply ) -import Util ( maybeRead ) -import Unique -import UniqFM -import IfaceEnv - -import qualified Data.Array as A -import Data.IORef -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import Data.List ( mapAccumR ) -import Data.Word ( Word8, Word32 ) -import Control.Monad ( replicateM, when ) -import System.Directory ( createDirectoryIfMissing ) -import System.FilePath ( takeDirectory ) - -import HieTypes - --- | `Name`'s get converted into `HieName`'s before being written into @.hie@ --- files. See 'toHieName' and 'fromHieName' for logic on how to convert between --- these two types. -data HieName - = ExternalName !Module !OccName !SrcSpan - | LocalName !OccName !SrcSpan - | KnownKeyName !Unique - deriving (Eq) - -instance Ord HieName where - compare (ExternalName a b c) (ExternalName d e f) = compare (a,b,c) (d,e,f) - compare (LocalName a b) (LocalName c d) = compare (a,b) (c,d) - compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b - -- Not actually non determinstic as it is a KnownKey - compare ExternalName{} _ = LT - compare LocalName{} ExternalName{} = GT - compare LocalName{} _ = LT - compare KnownKeyName{} _ = GT - -instance Outputable HieName where - ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp - ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp - ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u - - -data HieSymbolTable = HieSymbolTable - { hie_symtab_next :: !FastMutInt - , hie_symtab_map :: !(IORef (UniqFM (Int, HieName))) - } - -data HieDictionary = HieDictionary - { hie_dict_next :: !FastMutInt -- The next index to use - , hie_dict_map :: !(IORef (UniqFM (Int,FastString))) -- indexed by FastString - } - -initBinMemSize :: Int -initBinMemSize = 1024*1024 - --- | The header for HIE files - Capital ASCII letters "HIE". -hieMagic :: [Word8] -hieMagic = [72,73,69] - -hieMagicLen :: Int -hieMagicLen = length hieMagic - -ghcVersion :: ByteString -ghcVersion = BSC.pack cProjectVersion - -putBinLine :: BinHandle -> ByteString -> IO () -putBinLine bh xs = do - mapM_ (putByte bh) $ BS.unpack xs - putByte bh 10 -- newline char - --- | Write a `HieFile` to the given `FilePath`, with a proper header and --- symbol tables for `Name`s and `FastString`s -writeHieFile :: FilePath -> HieFile -> IO () -writeHieFile hie_file_path hiefile = do - bh0 <- openBinMem initBinMemSize - - -- Write the header: hieHeader followed by the - -- hieVersion and the GHC version used to generate this file - mapM_ (putByte bh0) hieMagic - putBinLine bh0 $ BSC.pack $ show hieVersion - putBinLine bh0 $ ghcVersion - - -- remember where the dictionary pointer will go - dict_p_p <- tellBin bh0 - put_ bh0 dict_p_p - - -- remember where the symbol table pointer will go - symtab_p_p <- tellBin bh0 - put_ bh0 symtab_p_p - - -- Make some intial state - symtab_next <- newFastMutInt - writeFastMutInt symtab_next 0 - symtab_map <- newIORef emptyUFM - let hie_symtab = HieSymbolTable { - hie_symtab_next = symtab_next, - hie_symtab_map = symtab_map } - dict_next_ref <- newFastMutInt - writeFastMutInt dict_next_ref 0 - dict_map_ref <- newIORef emptyUFM - let hie_dict = HieDictionary { - hie_dict_next = dict_next_ref, - hie_dict_map = dict_map_ref } - - -- put the main thing - let bh = setUserData bh0 $ newWriteState (putName hie_symtab) - (putName hie_symtab) - (putFastString hie_dict) - put_ bh hiefile - - -- write the symtab pointer at the front of the file - symtab_p <- tellBin bh - putAt bh symtab_p_p symtab_p - seekBin bh symtab_p - - -- write the symbol table itself - symtab_next' <- readFastMutInt symtab_next - symtab_map' <- readIORef symtab_map - putSymbolTable bh symtab_next' symtab_map' - - -- write the dictionary pointer at the front of the file - dict_p <- tellBin bh - putAt bh dict_p_p dict_p - seekBin bh dict_p - - -- write the dictionary itself - dict_next <- readFastMutInt dict_next_ref - dict_map <- readIORef dict_map_ref - putDictionary bh dict_next dict_map - - -- and send the result to the file - createDirectoryIfMissing True (takeDirectory hie_file_path) - writeBinMem bh hie_file_path - return () - -data HieFileResult - = HieFileResult - { hie_file_result_version :: Integer - , hie_file_result_ghc_version :: ByteString - , hie_file_result :: HieFile - } - -type HieHeader = (Integer, ByteString) - --- | Read a `HieFile` from a `FilePath`. Can use --- an existing `NameCache`. Allows you to specify --- which versions of hieFile to attempt to read. --- `Left` case returns the failing header versions. -readHieFileWithVersion :: (HieHeader -> Bool) -> NameCacheUpdater -> FilePath -> IO (Either HieHeader HieFileResult) -readHieFileWithVersion readVersion ncu file = do - bh0 <- readBinMem file - - (hieVersion, ghcVersion) <- readHieFileHeader file bh0 - - if readVersion (hieVersion, ghcVersion) - then do - hieFile <- readHieFileContents bh0 ncu - return $ Right (HieFileResult hieVersion ghcVersion hieFile) - else return $ Left (hieVersion, ghcVersion) - - --- | Read a `HieFile` from a `FilePath`. Can use --- an existing `NameCache`. -readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult -readHieFile ncu file = do - - bh0 <- readBinMem file - - (readHieVersion, ghcVersion) <- readHieFileHeader file bh0 - - -- Check if the versions match - when (readHieVersion /= hieVersion) $ - panic $ unwords ["readHieFile: hie file versions don't match for file:" - , file - , "Expected" - , show hieVersion - , "but got", show readHieVersion - ] - hieFile <- readHieFileContents bh0 ncu - return $ HieFileResult hieVersion ghcVersion hieFile - -readBinLine :: BinHandle -> IO ByteString -readBinLine bh = BS.pack . reverse <$> loop [] - where - loop acc = do - char <- get bh :: IO Word8 - if char == 10 -- ASCII newline '\n' - then return acc - else loop (char : acc) - -readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader -readHieFileHeader file bh0 = do - -- Read the header - magic <- replicateM hieMagicLen (get bh0) - version <- BSC.unpack <$> readBinLine bh0 - case maybeRead version of - Nothing -> - panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:" - , show version - ] - Just readHieVersion -> do - ghcVersion <- readBinLine bh0 - - -- Check if the header is valid - when (magic /= hieMagic) $ - panic $ unwords ["readHieFileHeader: headers don't match for file:" - , file - , "Expected" - , show hieMagic - , "but got", show magic - ] - return (readHieVersion, ghcVersion) - -readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile -readHieFileContents bh0 ncu = do - - dict <- get_dictionary bh0 - - -- read the symbol table so we are capable of reading the actual data - bh1 <- do - let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") - (getDictFastString dict) - symtab <- get_symbol_table bh1 - let bh1' = setUserData bh1 - $ newReadState (getSymTabName symtab) - (getDictFastString dict) - return bh1' - - -- load the actual data - hiefile <- get bh1 - return hiefile - where - get_dictionary bin_handle = do - dict_p <- get bin_handle - data_p <- tellBin bin_handle - seekBin bin_handle dict_p - dict <- getDictionary bin_handle - seekBin bin_handle data_p - return dict - - get_symbol_table bh1 = do - symtab_p <- get bh1 - data_p' <- tellBin bh1 - seekBin bh1 symtab_p - symtab <- getSymbolTable bh1 ncu - seekBin bh1 data_p' - return symtab - -putFastString :: HieDictionary -> BinHandle -> FastString -> IO () -putFastString HieDictionary { hie_dict_next = j_r, - hie_dict_map = out_r} bh f - = do - out <- readIORef out_r - let unique = getUnique f - case lookupUFM out unique of - Just (j, _) -> put_ bh (fromIntegral j :: Word32) - Nothing -> do - j <- readFastMutInt j_r - put_ bh (fromIntegral j :: Word32) - writeFastMutInt j_r (j + 1) - writeIORef out_r $! addToUFM out unique (j, f) - -putSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO () -putSymbolTable bh next_off symtab = do - put_ bh next_off - let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab)) - mapM_ (putHieName bh) names - -getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable -getSymbolTable bh ncu = do - sz <- get bh - od_names <- replicateM sz (getHieName bh) - updateNameCache ncu $ \nc -> - let arr = A.listArray (0,sz-1) names - (nc', names) = mapAccumR fromHieName nc od_names - in (nc',arr) - -getSymTabName :: SymbolTable -> BinHandle -> IO Name -getSymTabName st bh = do - i :: Word32 <- get bh - return $ st A.! (fromIntegral i) - -putName :: HieSymbolTable -> BinHandle -> Name -> IO () -putName (HieSymbolTable next ref) bh name = do - symmap <- readIORef ref - case lookupUFM symmap name of - Just (off, ExternalName mod occ (UnhelpfulSpan _)) - | isGoodSrcSpan (nameSrcSpan name) -> do - let hieName = ExternalName mod occ (nameSrcSpan name) - writeIORef ref $! addToUFM symmap name (off, hieName) - put_ bh (fromIntegral off :: Word32) - Just (off, LocalName _occ span) - | notLocal (toHieName name) || nameSrcSpan name /= span -> do - writeIORef ref $! addToUFM symmap name (off, toHieName name) - put_ bh (fromIntegral off :: Word32) - Just (off, _) -> put_ bh (fromIntegral off :: Word32) - Nothing -> do - off <- readFastMutInt next - writeFastMutInt next (off+1) - writeIORef ref $! addToUFM symmap name (off, toHieName name) - put_ bh (fromIntegral off :: Word32) - - where - notLocal :: HieName -> Bool - notLocal LocalName{} = False - notLocal _ = True - - --- ** Converting to and from `HieName`'s - -toHieName :: Name -> HieName -toHieName name - | isKnownKeyName name = KnownKeyName (nameUnique name) - | isExternalName name = ExternalName (nameModule name) - (nameOccName name) - (nameSrcSpan name) - | otherwise = LocalName (nameOccName name) (nameSrcSpan name) - -fromHieName :: NameCache -> HieName -> (NameCache, Name) -fromHieName nc (ExternalName mod occ span) = - let cache = nsNames nc - in case lookupOrigNameCache cache mod occ of - Just name - | nameSrcSpan name == span -> (nc, name) - | otherwise -> - let name' = setNameLoc name span - new_cache = extendNameCache cache mod occ name' - in ( nc{ nsNames = new_cache }, name' ) - Nothing -> - let (uniq, us) = takeUniqFromSupply (nsUniqs nc) - name = mkExternalName uniq mod occ span - new_cache = extendNameCache cache mod occ name - in ( nc{ nsUniqs = us, nsNames = new_cache }, name ) -fromHieName nc (LocalName occ span) = - let (uniq, us) = takeUniqFromSupply (nsUniqs nc) - name = mkInternalName uniq occ span - in ( nc{ nsUniqs = us }, name ) -fromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of - Nothing -> pprPanic "fromHieName:unknown known-key unique" - (ppr (unpkUnique u)) - Just n -> (nc, n) - --- ** Reading and writing `HieName`'s - -putHieName :: BinHandle -> HieName -> IO () -putHieName bh (ExternalName mod occ span) = do - putByte bh 0 - put_ bh (mod, occ, span) -putHieName bh (LocalName occName span) = do - putByte bh 1 - put_ bh (occName, span) -putHieName bh (KnownKeyName uniq) = do - putByte bh 2 - put_ bh $ unpkUnique uniq - -getHieName :: BinHandle -> IO HieName -getHieName bh = do - t <- getByte bh - case t of - 0 -> do - (modu, occ, span) <- get bh - return $ ExternalName modu occ span - 1 -> do - (occ, span) <- get bh - return $ LocalName occ span - 2 -> do - (c,i) <- get bh - return $ KnownKeyName $ mkUnique c i - _ -> panic "HieBin.getHieName: invalid tag" diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs index a3935b92e9..1c23bee738 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs @@ -62,17 +62,8 @@ getLiteral (L (locA -> (RealSrcSpan sSpan _)) expr) = case expr of _ -> Nothing getLiteral _ = Nothing - - --- GHC 8.8 typedefs LPat = Pat -#if __GLASGOW_HASKELL__ == 808 -type LocPat a = GenLocated SrcSpan (Pat a) -#else -type LocPat a = LPat a -#endif - -- | Destructure Patterns to unwrap any Literals -getPattern :: LocPat GhcPs -> Maybe Literal +getPattern :: LPat GhcPs -> Maybe Literal getPattern (L (locA -> (RealSrcSpan patSpan _)) pat) = case pat of LitPat _ lit -> case lit of HsInt _ val -> fromIntegralLit patSpan val 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 2ed90bab48..c1a71c4d40 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -305,9 +305,6 @@ runEvalCmd plId st EvalParams{..} = #endif -- Load the module with its current content (as the saved module might not be up to date) - -- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8 - -- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066 - -- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile eSetTarget <- gStrictTry $ setTargets [thisModuleTarget] dbg "setTarget" eSetTarget diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index 19e7efe6e6..e7297e1db8 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -3,11 +3,7 @@ module Development.IDE.GHC.Dump(showAstDataHtml) where import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (NameAnn) import Development.IDE.GHC.Compat.ExactPrint -#if MIN_VERSION_ghc(8,10,1) import GHC.Hs.Dump -#else -import HsDumpAst -#endif #if MIN_VERSION_ghc(9,2,1) import qualified Data.ByteString as B import Development.IDE.GHC.Compat.Util diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index d56b513a79..8368efa249 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -489,13 +489,8 @@ instance p ~ GhcPs => ASTElement AnnListItem (HsExpr p) where graft = graftExpr instance p ~ GhcPs => ASTElement AnnListItem (Pat p) where -#if __GLASGOW_HASKELL__ == 808 - parseAST = fmap (fmap $ right $ second dL) . parsePattern - maybeParensAST = dL . parenthesizePat appPrec . unLoc -#else parseAST = parsePattern maybeParensAST = parenthesizePat appPrec -#endif instance p ~ GhcPs => ASTElement AnnListItem (HsType p) where parseAST = parseType diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index e5b6883fce..3b4d632822 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -559,8 +559,4 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} ideclExt = GHC.noExtField #endif ideclAs = toMod <$> ideclAsString -#if MIN_VERSION_ghc(8,10,0) ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified -#else - ideclQualified = ideclQualifiedBool -#endif diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 41b5774706..aabb3b09ee 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -126,9 +126,6 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do let exprSuperSpans = listToMaybe $ findSubSpansDesc srcSpan exprSplices _patSuperSpans = -#if __GLASGOW_HASKELL__ == 808 - fmap (second dL) $ -#endif listToMaybe $ findSubSpansDesc srcSpan patSplices typeSuperSpans = listToMaybe $ findSubSpansDesc srcSpan typeSplices diff --git a/plugins/hls-stan-plugin/hls-stan-plugin.cabal b/plugins/hls-stan-plugin/hls-stan-plugin.cabal index 370d206f81..5a8632d173 100644 --- a/plugins/hls-stan-plugin/hls-stan-plugin.cabal +++ b/plugins/hls-stan-plugin/hls-stan-plugin.cabal @@ -26,7 +26,7 @@ flag pedantic manual: True library - if impl(ghc < 8.8) || impl(ghc >= 9.0) + if impl(ghc < 8.10) || impl(ghc >= 9.0) buildable: False else buildable: True @@ -58,7 +58,7 @@ library OverloadedStrings test-suite test - if impl(ghc < 8.8) || impl(ghc >= 9.0) + if impl(ghc < 8.10) || impl(ghc >= 9.0) buildable: False else buildable: True diff --git a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs index 3693d7c1d3..abea111b07 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs @@ -18,7 +18,7 @@ import Development.IDE.GHC.ExactPrint import Generics.SYB.GHC (mkBindListT, everywhereM') import Wingman.AbstractLSP.Types import Wingman.CaseSplit -import Wingman.GHC (liftMaybe, isHole, pattern AMatch, unXPat) +import Wingman.GHC (liftMaybe, isHole, pattern AMatch) import Wingman.Judgements (jNeedsToBindArgs) import Wingman.LanguageServer (runStaleIde) import Wingman.LanguageServer.TacticProviders @@ -133,7 +133,7 @@ graftHole span rtr ) (occName name) $ iterateSplit - $ mkFirstAgda (fmap unXPat pats) + $ mkFirstAgda pats $ unLoc $ rtr_extract rtr graftHole span rtr diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index e90fce6de8..4c548bd72e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -277,17 +277,6 @@ class PatCompattable p where fromPatCompat :: PatCompat p -> Pat p toPatCompat :: Pat p -> PatCompat p -#if __GLASGOW_HASKELL__ == 808 -instance PatCompattable GhcTc where - fromPatCompat = id - toPatCompat = id - -instance PatCompattable GhcPs where - fromPatCompat = id - toPatCompat = id - -type PatCompat pass = Pat pass -#else instance PatCompattable GhcTc where fromPatCompat = unLoc toPatCompat = noLoc @@ -297,7 +286,6 @@ instance PatCompattable GhcPs where toPatCompat = noLoc type PatCompat pass = LPat pass -#endif ------------------------------------------------------------------------------ -- | Should make sure it's a fun bind @@ -314,19 +302,6 @@ pattern TopLevelRHS name ps body where_binds <- (GRHSs _ [L _ (GRHS _ [] body)] (L _ where_binds)) ------------------------------------------------------------------------------- --- | In GHC 8.8, sometimes patterns are wrapped in 'XPat'. --- The nitty gritty details are explained at --- https://blog.shaynefletcher.org/2020/03/ghc-haskell-pats-and-lpats.html --- --- We need to remove these in order to succesfull find patterns. -unXPat :: Pat GhcPs -> Pat GhcPs -#if __GLASGOW_HASKELL__ == 808 -unXPat (XPat (L _ pat)) = unXPat pat -#endif -unXPat pat = pat - - liftMaybe :: Monad m => Maybe a -> MaybeT m a liftMaybe a = MaybeT $ pure a diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index 2db38a2a8b..829e1dda90 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -426,9 +426,6 @@ buildPatHy prov (fromPatCompat -> p0) = RecCon r -> mkDerivedRecordHypothesis prov con args r SigPat _ p _ -> buildPatHy prov p -#if __GLASGOW_HASKELL__ == 808 - XPat p -> buildPatHy prov $ unLoc p -#endif _ -> pure mempty @@ -583,10 +580,6 @@ wingmanRules recorder plId = do #endif | isHole occ -> maybeToList $ srcSpanToRange span -#if __GLASGOW_HASKELL__ == 808 - L span (EWildPat _) -> - maybeToList $ srcSpanToRange span -#endif (_ :: LHsExpr GhcPs) -> mempty ) $ pm_parsed_source pm pure diff --git a/stack-lts16.yaml b/stack-lts16.yaml deleted file mode 100644 index 40449ab4d5..0000000000 --- a/stack-lts16.yaml +++ /dev/null @@ -1,129 +0,0 @@ -resolver: lts-16.31 # last 8.8.4 lts - -packages: - - . - - ./hie-compat - - ./hls-graph - - ./ghcide/ - - ./ghcide/test - - ./shake-bench - - ./hls-plugin-api - - ./hls-test-utils - - ./plugins/hls-call-hierarchy-plugin - - ./plugins/hls-class-plugin - - ./plugins/hls-haddock-comments-plugin - - ./plugins/hls-eval-plugin - - ./plugins/hls-explicit-imports-plugin - - ./plugins/hls-refine-imports-plugin - - ./plugins/hls-hlint-plugin - - ./plugins/hls-stan-plugin - - ./plugins/hls-rename-plugin - - ./plugins/hls-retrie-plugin - - ./plugins/hls-splice-plugin - - ./plugins/hls-tactics-plugin - - ./plugins/hls-qualify-imported-names-plugin - - ./plugins/hls-brittany-plugin - - ./plugins/hls-stylish-haskell-plugin - - ./plugins/hls-floskell-plugin - - ./plugins/hls-fourmolu-plugin - - ./plugins/hls-pragmas-plugin - - ./plugins/hls-module-name-plugin - - ./plugins/hls-ormolu-plugin - - ./plugins/hls-alternate-number-format-plugin - - ./plugins/hls-code-range-plugin - - ./plugins/hls-change-type-signature-plugin - - ./plugins/hls-gadt-plugin - - ./plugins/hls-explicit-fixity-plugin - - ./plugins/hls-refactor-plugin - -ghc-options: - "$everything": -haddock - -extra-deps: - - aeson-1.5.2.0 - - apply-refact-0.9.3.0 - - brittany-0.13.1.2 - - bytestring-trie-0.2.5.0 - - cabal-plan-0.6.2.0 - - clock-0.7.2 - - constrained-dynamic-0.1.0.0 - - extra-1.7.10 - - floskell-0.10.4 - - fourmolu-0.3.0.0 - - ghc-check-0.5.0.8 - - ghc-exactprint-0.6.4 - - ghc-lib-8.10.7.20210828 - - ghc-lib-parser-8.10.7.20210828 - - ghc-source-gen-0.4.1.0 - - ghc-trace-events-0.1.2.1 - - haskell-src-exts-1.21.1 - - hlint-3.2.8 - - HsYAML-aeson-0.2.0.0@rev:2 - - hoogle-5.0.17.11 - - hsimport-0.11.0 - - ilist-0.3.1.0 - - implicit-hie-cradle-0.3.0.5 - - implicit-hie-0.1.2.6 - - megaparsec-9.0.1 - - monad-dijkstra-0.1.1.2 - - opentelemetry-0.6.1 - - opentelemetry-extra-0.6.1 - - refinery-0.4.0.0 - - retrie-1.1.0.0 - - semigroups-0.18.5 - - shake-0.19.4 - - stylish-haskell-0.12.2.0 - - 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.2.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 - - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 - - constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853 - - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 - - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - - stm-containers-1.1.0.4 - - stm-hamt-1.2.0.6@sha256:fba86ccb4b45c5706c19b0e1315ba63dcac3b5d71de945ec001ba921fae80061,3972 - - primitive-extras-0.10.1 - - primitive-unlifted-0.1.3.1 - - githash-0.1.6.2 - - stan-0.0.1.0 - - dir-traverse-0.2.3.0@sha256:adcc128f201ff95131b15ffe41365dc99c50dc3fa3a910f021521dc734013bfa,2137 - - extensions-0.0.0.1@sha256:16517ab9df3dd6c7a20da746c8ed02cfd59c8cb40ae5719aef8b5dd4edceadc0,3993 - - microaeson-0.1.0.1@sha256:88ba1cc52181b57abc453e222bbb76ca6ab252e38c6507d15a596d6a582fdf69,3968 - - trial-0.0.0.0@sha256:834d3be439dc9b52a759a45a4d3944e5e55c3d50fd5874003147cc1f6231d4aa,4301 - - trial-optparse-applicative-0.0.0.0@sha256:ba05edfc327a281766df5e0f44d91229e6a98afaf59abe1894b293453f076192,2449 - - trial-tomland-0.0.0.0@sha256:743a9baaa36891ed3a44618fdfd5bc4ed9afc39cf9b9fa23ea1b96f3787f5ec0,2526 - - text-rope-0.2 - - co-log-core-0.3.1.0 - - lsp-1.6.0.0 - - lsp-types-1.6.0.0 - - lsp-test-0.14.1.0 - - hie-bios-0.11.0 - - prettyprinter-1.7.1@sha256:9c43c9d8c3cd9f445596e5a2379574bba87f935a4d1fa41b5407ee3cf4edc743,6987 - -configure-options: - ghcide: - - --disable-library-for-ghci - haskell-language-server: - - --disable-library-for-ghci - heapsize: - - --disable-library-for-ghci - -flags: - haskell-language-server: - pedantic: true - retrie: - BuildExecutable: false - hyphenation: - embed: true - hlint: - ghc-lib: true - -nix: - packages: [icu libcxx zlib] - -concurrent-tests: false diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 8a33eddbe5..7ad0824179 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -376,4 +376,4 @@ compls `shouldNotContainCompl` lbl = @? "Should not contain completion: " ++ show lbl expectFailIfBeforeGhc92 :: String -> TestTree -> TestTree -expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC810, GHC88, GHC90] +expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC810, GHC90] diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 96f4ab91f0..f191fbfe7e 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -13,8 +13,7 @@ tests = testGroup "type definitions" [ $ getTypeDefinitionTest' 15 21 12 0 , testCase "finds local definition of sum type variable" $ getTypeDefinitionTest' 20 13 17 0 - , knownBrokenForGhcVersions [GHC88] "Definition of sum type not found from data constructor in GHC 8.8.x" $ - testCase "finds local definition of sum type constructor" + , testCase "finds local definition of sum type constructor" $ getTypeDefinitionTest' 23 7 17 0 , testCase "finds non-local definition of type def" $ getTypeDefinitionTest' 29 19 26 0 diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs index 1e6f205a6d..6c68440a5f 100644 --- a/test/wrapper/Main.hs +++ b/test/wrapper/Main.hs @@ -12,7 +12,6 @@ main = do projectGhcVersionTests :: TestTree projectGhcVersionTests = testGroup "--project-ghc-version" [ stackTest "8.10.7" - , stackTest "8.8.4" , testCase "cabal with global ghc" $ do ghcVer <- trimEnd <$> readProcess "ghc" ["--numeric-version"] "" testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer diff --git a/test/wrapper/testdata/stack-8.8.4/Lib.hs b/test/wrapper/testdata/stack-8.8.4/Lib.hs deleted file mode 100644 index 30bf1ec6b8..0000000000 --- a/test/wrapper/testdata/stack-8.8.4/Lib.hs +++ /dev/null @@ -1,2 +0,0 @@ -module Lib where -foo = 42 diff --git a/test/wrapper/testdata/stack-8.8.4/foo.cabal b/test/wrapper/testdata/stack-8.8.4/foo.cabal deleted file mode 100644 index affc654cad..0000000000 --- a/test/wrapper/testdata/stack-8.8.4/foo.cabal +++ /dev/null @@ -1,7 +0,0 @@ -cabal-version: 2.4 -name: foo -version: 0.1.0.0 -library - exposed-modules: Lib - build-depends: base - default-language: Haskell2010 diff --git a/test/wrapper/testdata/stack-8.8.4/stack.yaml b/test/wrapper/testdata/stack-8.8.4/stack.yaml deleted file mode 100644 index f9dba12313..0000000000 --- a/test/wrapper/testdata/stack-8.8.4/stack.yaml +++ /dev/null @@ -1 +0,0 @@ -resolver: ghc-8.8.4