diff --git a/.github/actions/bindist-actions/action-centos7/action.yaml b/.github/actions/bindist-actions/action-centos7/action.yaml deleted file mode 100644 index 66f97295f0..0000000000 --- a/.github/actions/bindist-actions/action-centos7/action.yaml +++ /dev/null @@ -1,23 +0,0 @@ -description: Container for centos7 -inputs: - stage: - description: which stage to build - required: true - version: - description: which GHC version to build/test - required: false -name: action-centos7 -runs: - entrypoint: .github/scripts/entrypoint.sh - env: - GHC_VERSION: ${{ inputs.version }} - INSTALL: sed -i 's/mirrorlist/#mirrorlist/g' /etc/yum.repos.d/CentOS-* && sed - -i 's|#baseurl=http://mirror.centos.org|baseurl=http://vault.centos.org|g' /etc/yum.repos.d/CentOS-* - && yum -y install epel-release && yum install -y - STAGE: ${{ inputs.stage }} - TOOLS: autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs - findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs - ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which - xz zlib-devel patchelf - image: centos:7 - using: docker diff --git a/.github/actions/bindist-actions/action-deb12/action.yaml b/.github/actions/bindist-actions/action-deb12/action.yaml new file mode 100644 index 0000000000..20bcc6a157 --- /dev/null +++ b/.github/actions/bindist-actions/action-deb12/action.yaml @@ -0,0 +1,21 @@ +description: Container for deb12 +inputs: + stage: + description: which stage to build + required: true + version: + description: which GHC version to build/test + required: false +name: action-deb12 +runs: + entrypoint: .github/scripts/entrypoint.sh + env: + GHC_VERSION: ${{ inputs.version }} + INSTALL: apt-get update && apt-get install -y + STAGE: ${{ inputs.stage }} + TOOLS: libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev + git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc + autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 + libtinfo5 patchelf + image: debian:12 + using: docker diff --git a/.github/actions/bindist-actions/action-fedora27/action.yaml b/.github/actions/bindist-actions/action-fedora40/action.yaml similarity index 88% rename from .github/actions/bindist-actions/action-fedora27/action.yaml rename to .github/actions/bindist-actions/action-fedora40/action.yaml index e77b944a5e..83f23b23c8 100644 --- a/.github/actions/bindist-actions/action-fedora27/action.yaml +++ b/.github/actions/bindist-actions/action-fedora40/action.yaml @@ -1,4 +1,4 @@ -description: Container for fedora27 +description: Container for fedora40 inputs: stage: description: which stage to build @@ -6,7 +6,7 @@ inputs: version: description: which GHC version to build/test required: false -name: action-fedora27 +name: action-fedora40 runs: entrypoint: .github/scripts/entrypoint.sh env: @@ -17,5 +17,5 @@ runs: findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf - image: fedora:27 + image: fedora:40 using: docker diff --git a/.github/actions/bindist-actions/action-mint213/action.yaml b/.github/actions/bindist-actions/action-mint213/action.yaml new file mode 100644 index 0000000000..bd09dc0e97 --- /dev/null +++ b/.github/actions/bindist-actions/action-mint213/action.yaml @@ -0,0 +1,21 @@ +description: Container for mint213 +inputs: + stage: + description: which stage to build + required: true + version: + description: which GHC version to build/test + required: false +name: action-mint213 +runs: + entrypoint: .github/scripts/entrypoint.sh + env: + GHC_VERSION: ${{ inputs.version }} + INSTALL: apt-get update && apt-get install -y + STAGE: ${{ inputs.stage }} + TOOLS: libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev + git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc + autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 + libtinfo5 patchelf + image: linuxmintd/mint21.3-amd64 + using: docker diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index da1ece3140..11f32c09db 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -31,7 +31,7 @@ runs: sudo chown -R $USER /usr/local/.ghcup shell: bash - - uses: haskell-actions/setup@v2.7.10 + - uses: haskell-actions/setup@v2.8.1 id: HaskEnvSetup with: ghc-version : ${{ inputs.ghc }} diff --git a/.github/generate-ci/gen_ci.hs b/.github/generate-ci/gen_ci.hs index 1cdba1ca41..28a81d8576 100644 --- a/.github/generate-ci/gen_ci.hs +++ b/.github/generate-ci/gen_ci.hs @@ -1,21 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} -import Control.Monad -import Data.Maybe +import Control.Monad +import Data.Maybe -import Data.Aeson hiding ( encode ) -import Data.Aeson.Types (Pair) -import qualified Data.Aeson.Key as K -import Data.Yaml +import Data.Aeson hiding (encode) +import qualified Data.Aeson.Key as K +import Data.Aeson.Types (Pair) +import Data.Yaml -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS -import qualified Data.List as L +import qualified Data.List as L -import System.Directory -import System.FilePath -import System.Environment +import System.Directory +import System.Environment +import System.FilePath ------------------------------------------------------------------------------- -- Configuration parameters @@ -27,22 +27,23 @@ data Opsys | Windows deriving (Eq) osName :: Opsys -> String -osName Darwin = "mac" -osName Windows = "windows" +osName Darwin = "mac" +osName Windows = "windows" osName (Linux d) = "linux-" ++ distroName d data Distro = Debian9 | Debian10 | Debian11 + | Debian12 | Ubuntu1804 | Ubuntu2004 | Ubuntu2204 | Mint193 | Mint202 - | Fedora27 + | Mint213 | Fedora33 - | Centos7 + | Fedora40 | Rocky8 deriving (Eq, Enum, Bounded) @@ -51,28 +52,26 @@ allDistros = [minBound .. maxBound] data Arch = Amd64 | AArch64 archName :: Arch -> String -archName Amd64 = "x86_64" +archName Amd64 = "x86_64" archName AArch64 = "aarch64" artifactName :: Arch -> Opsys -> String artifactName arch opsys = archName arch ++ "-" ++ case opsys of Linux distro -> "linux-" ++ distroName distro - Darwin -> "apple-darwin" - Windows -> "mingw64" + Darwin -> "apple-darwin" + Windows -> "mingw64" data GHC - = GHC948 - | GHC967 + = GHC967 | GHC984 - | GHC9101 + | GHC9102 | GHC9122 deriving (Eq, Enum, Bounded) ghcVersion :: GHC -> String -ghcVersion GHC948 = "9.4.8" -ghcVersion GHC967 = "9.6.7" -ghcVersion GHC984 = "9.8.4" -ghcVersion GHC9101 = "9.10.1" +ghcVersion GHC967 = "9.6.7" +ghcVersion GHC984 = "9.8.4" +ghcVersion GHC9102 = "9.10.2" ghcVersion GHC9122 = "9.12.2" ghcVersionIdent :: GHC -> String @@ -88,59 +87,63 @@ data Stage = Build GHC | Bindist | Test ------------------------------------------------------------------------------- distroImage :: Distro -> String -distroImage Debian9 = "debian:9" -distroImage Debian10 = "debian:10" -distroImage Debian11 = "debian:11" +distroImage Debian9 = "debian:9" +distroImage Debian10 = "debian:10" +distroImage Debian11 = "debian:11" +distroImage Debian12 = "debian:12" distroImage Ubuntu1804 = "ubuntu:18.04" distroImage Ubuntu2004 = "ubuntu:20.04" distroImage Ubuntu2204 = "ubuntu:22.04" -distroImage Mint193 = "linuxmintd/mint19.3-amd64" -distroImage Mint202 = "linuxmintd/mint20.2-amd64" -distroImage Fedora27 = "fedora:27" -distroImage Fedora33 = "fedora:33" -distroImage Centos7 = "centos:7" -distroImage Rocky8 = "rockylinux:8" +distroImage Mint193 = "linuxmintd/mint19.3-amd64" +distroImage Mint202 = "linuxmintd/mint20.2-amd64" +distroImage Mint213 = "linuxmintd/mint21.3-amd64" +distroImage Fedora33 = "fedora:33" +distroImage Fedora40 = "fedora:40" +distroImage Rocky8 = "rockylinux:8" distroName :: Distro -> String -distroName Debian9 = "deb9" -distroName Debian10 = "deb10" -distroName Debian11 = "deb11" +distroName Debian9 = "deb9" +distroName Debian10 = "deb10" +distroName Debian11 = "deb11" +distroName Debian12 = "deb12" distroName Ubuntu1804 = "ubuntu1804" distroName Ubuntu2004 = "ubuntu2004" distroName Ubuntu2204 = "ubuntu2204" -distroName Mint193 = "mint193" -distroName Mint202 = "mint202" -distroName Fedora27 = "fedora27" -distroName Fedora33 = "fedora33" -distroName Centos7 = "centos7" -distroName Rocky8 = "unknown" +distroName Mint193 = "mint193" +distroName Mint202 = "mint202" +distroName Mint213 = "mint213" +distroName Fedora33 = "fedora33" +distroName Fedora40 = "fedora40" +distroName Rocky8 = "unknown" distroInstall :: Distro -> String distroInstall Debian9 = "sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && sed -i 's|security.debian.org|archive.debian.org/|g' /etc/apt/sources.list && sed -i /-updates/d /etc/apt/sources.list && apt-get update && apt-get install -y" distroInstall Debian10 = "apt-get update && apt-get install -y" distroInstall Debian11 = "apt-get update && apt-get install -y" +distroInstall Debian12 = "apt-get update && apt-get install -y" distroInstall Ubuntu1804 = "apt-get update && apt-get install -y" distroInstall Ubuntu2004 = "apt-get update && apt-get install -y" distroInstall Ubuntu2204 = "apt-get update && apt-get install -y" distroInstall Mint193 = "apt-get update && apt-get install -y" distroInstall Mint202 = "apt-get update && apt-get install -y" -distroInstall Fedora27 = "dnf install -y" +distroInstall Mint213 = "apt-get update && apt-get install -y" distroInstall Fedora33 = "dnf install -y" -distroInstall Centos7 = "sed -i 's/mirrorlist/#mirrorlist/g' /etc/yum.repos.d/CentOS-* && sed -i 's|#baseurl=http://mirror.centos.org|baseurl=http://vault.centos.org|g' /etc/yum.repos.d/CentOS-* && yum -y install epel-release && yum install -y" +distroInstall Fedora40 = "dnf install -y" distroInstall Rocky8 = "yum -y install epel-release && yum install -y --allowerasing" distroTools :: Distro -> String distroTools Debian9 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Debian10 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Debian11 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" +distroTools Debian12 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Ubuntu1804 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Ubuntu2004 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Ubuntu2204 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Mint193 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Mint202 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" -distroTools Fedora27 = "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" +distroTools Mint213 = "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" distroTools Fedora33 = "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" -distroTools Centos7 = "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" +distroTools Fedora40 = "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" distroTools Rocky8 = "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" ------------------------------------------------------------------------------- @@ -160,13 +163,13 @@ envVars arch os = object $ baseEnv ++ [ "TARBALL_EXT" .= str (case os of Windows -> "zip" - _ -> "tar.xz") + _ -> "tar.xz") , "ARCH" .= str (case arch of - Amd64 -> "64" + Amd64 -> "64" AArch64 -> "ARM64") , "ADD_CABAL_ARGS" .= str (case (os,arch) of (Linux _, Amd64) -> "--enable-split-sections" - _ -> "") + _ -> "") , "ARTIFACT" .= artifactName arch os ] ++ [ "DEBIAN_FRONTEND" .= str "noninteractive" @@ -181,21 +184,21 @@ envVars arch os = object $ -- | Runner selection runner :: Arch -> Opsys -> [Value] -runner Amd64 (Linux _) = ["ubuntu-latest"] +runner Amd64 (Linux _) = ["ubuntu-latest"] runner AArch64 (Linux _) = ["self-hosted", "Linux", "ARM64", "maerwald"] -runner Amd64 Darwin = ["macOS-13"] -runner AArch64 Darwin = ["self-hosted", "macOS", "ARM64"] -runner Amd64 Windows = ["windows-latest"] -runner AArch64 Windows = error "aarch64 windows not supported" +runner Amd64 Darwin = ["macOS-13"] +runner AArch64 Darwin = ["self-hosted", "macOS", "ARM64"] +runner Amd64 Windows = ["windows-latest"] +runner AArch64 Windows = error "aarch64 windows not supported" -- | Runner selection for bindist jobs bindistRunner :: Arch -> Opsys -> [Value] -bindistRunner Amd64 (Linux _) = ["self-hosted", "linux-space", "maerwald"] +bindistRunner Amd64 (Linux _) = ["self-hosted", "linux-space", "maerwald"] bindistRunner AArch64 (Linux _) = ["self-hosted", "Linux", "ARM64", "maerwald"] -bindistRunner Amd64 Darwin = ["macOS-13"] -bindistRunner AArch64 Darwin = ["self-hosted", "macOS", "ARM64"] -bindistRunner Amd64 Windows = ["windows-latest"] -bindistRunner AArch64 Windows = error "aarch64 windows not supported" +bindistRunner Amd64 Darwin = ["macOS-13"] +bindistRunner AArch64 Darwin = ["self-hosted", "macOS", "ARM64"] +bindistRunner Amd64 Windows = ["windows-latest"] +bindistRunner AArch64 Windows = error "aarch64 windows not supported" ------------------------------------------------------------------------------- -- Action generatation @@ -215,7 +218,7 @@ bindistRunner AArch64 Windows = error "aarch64 windows not supported" -- called 'actionName', located at 'actionPath' data Action = Action - { actionName :: String + { actionName :: String , actionDistro :: Distro } @@ -254,7 +257,7 @@ instance ToJSON Action where configAction :: Config -> Maybe Action configAction (MkConfig Amd64 (Linux d) _) = Just $ Action (distroActionName d) d -configAction _ = Nothing +configAction _ = Nothing distroActionName :: Distro -> String distroActionName d = "action-" ++ distroName d @@ -274,7 +277,7 @@ customAction d st = flip (ghAction stepName (actionPath d)) [] $ case st of where stepName = case st of Build v -> "Build " ++ ghcVersion v - Test -> "Test" + Test -> "Test" Bindist -> "Bindist" ------------------------------------------------------------------------------- diff --git a/.github/scripts/env.sh b/.github/scripts/env.sh index 90e7219661..2f6eaa3c48 100644 --- a/.github/scripts/env.sh +++ b/.github/scripts/env.sh @@ -35,3 +35,5 @@ fi export DEBIAN_FRONTEND=noninteractive export TZ=Asia/Singapore +export LANG=en_US.UTF-8 +export LC_ALL=C.UTF-8 diff --git a/.github/scripts/test.sh b/.github/scripts/test.sh index ad6676fd51..00638dca62 100644 --- a/.github/scripts/test.sh +++ b/.github/scripts/test.sh @@ -60,7 +60,7 @@ test_all_hls() { fi done # install the recommended GHC version so the wrapper can launch HLS - ghcup install ghc --set 9.10.1 + ghcup install ghc --set 9.10.2 "$bindir/haskell-language-server-wrapper${ext}" typecheck "${test_module}" || fail "failed to typecheck with HLS wrapper" } diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index c8953d4d2b..ba39a21058 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -127,7 +127,7 @@ jobs: example: ['cabal', 'lsp-types'] steps: - - uses: haskell-actions/setup@v2.7.11 + - uses: haskell-actions/setup@v2.8.1 with: ghc-version : ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index f62a8d1cd1..bdd770acd0 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -44,7 +44,9 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macOS-latest] + # TODO: Fix compilation problems on macOS. + # os: [ubuntu-latest, macOS-latest] + os: [ubuntu-latest] steps: - uses: actions/checkout@v3 diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 5eb3076d29..30c55d375a 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -18,10 +18,9 @@ jobs: TZ: Asia/Singapore name: bindist-aarch64-linux-ubuntu2004 (Prepare bindist) needs: - - build-aarch64-linux-ubuntu2004-948 - build-aarch64-linux-ubuntu2004-967 - build-aarch64-linux-ubuntu2004-984 - - build-aarch64-linux-ubuntu2004-9101 + - build-aarch64-linux-ubuntu2004-9102 - build-aarch64-linux-ubuntu2004-9122 runs-on: - self-hosted @@ -36,11 +35,6 @@ jobs: shell: bash - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-aarch64-linux-ubuntu2004-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -54,7 +48,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-aarch64-linux-ubuntu2004-9101 + name: artifacts-build-aarch64-linux-ubuntu2004-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -93,10 +87,9 @@ jobs: TZ: Asia/Singapore name: bindist-aarch64-mac (Prepare bindist) needs: - - build-aarch64-mac-948 - build-aarch64-mac-967 - build-aarch64-mac-984 - - build-aarch64-mac-9101 + - build-aarch64-mac-9102 - build-aarch64-mac-9122 runs-on: - self-hosted @@ -105,11 +98,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-aarch64-mac-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -123,7 +111,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-aarch64-mac-9101 + name: artifacts-build-aarch64-mac-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -155,24 +143,23 @@ jobs: ./out/plan.json/* ./out/*.zip retention-days: 2 - bindist-x86_64-linux-centos7: + bindist-x86_64-linux-deb10: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive S3_HOST: ${{ secrets.S3_HOST }} TARBALL_EXT: tar.xz TZ: Asia/Singapore - name: bindist-x86_64-linux-centos7 (Prepare bindist) + name: bindist-x86_64-linux-deb10 (Prepare bindist) needs: - - build-x86_64-linux-centos7-948 - - build-x86_64-linux-centos7-967 - - build-x86_64-linux-centos7-984 - - build-x86_64-linux-centos7-9101 - - build-x86_64-linux-centos7-9122 + - build-x86_64-linux-deb10-967 + - build-x86_64-linux-deb10-984 + - build-x86_64-linux-deb10-9102 + - build-x86_64-linux-deb10-9122 runs-on: - self-hosted - linux-space @@ -183,60 +170,54 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-centos7-948 - path: ./ - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-centos7-967 + name: artifacts-build-x86_64-linux-deb10-967 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-centos7-984 + name: artifacts-build-x86_64-linux-deb10-984 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-centos7-9101 + name: artifacts-build-x86_64-linux-deb10-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-centos7-9122 + name: artifacts-build-x86_64-linux-deb10-9122 path: ./ - name: Bindist - uses: ./.github/actions/bindist-actions/action-centos7 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: BINDIST - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: bindist-x86_64-linux-centos7 + name: bindist-x86_64-linux-deb10 path: |- ./out/*.tar.xz ./out/plan.json/* ./out/*.zip retention-days: 2 - bindist-x86_64-linux-deb10: + bindist-x86_64-linux-deb11: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive S3_HOST: ${{ secrets.S3_HOST }} TARBALL_EXT: tar.xz TZ: Asia/Singapore - name: bindist-x86_64-linux-deb10 (Prepare bindist) + name: bindist-x86_64-linux-deb11 (Prepare bindist) needs: - - build-x86_64-linux-deb10-948 - - build-x86_64-linux-deb10-967 - - build-x86_64-linux-deb10-984 - - build-x86_64-linux-deb10-9101 - - build-x86_64-linux-deb10-9122 + - build-x86_64-linux-deb11-967 + - build-x86_64-linux-deb11-984 + - build-x86_64-linux-deb11-9102 + - build-x86_64-linux-deb11-9122 runs-on: - self-hosted - linux-space @@ -247,60 +228,54 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb10-948 - path: ./ - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-deb10-967 + name: artifacts-build-x86_64-linux-deb11-967 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb10-984 + name: artifacts-build-x86_64-linux-deb11-984 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb10-9101 + name: artifacts-build-x86_64-linux-deb11-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb10-9122 + name: artifacts-build-x86_64-linux-deb11-9122 path: ./ - name: Bindist - uses: ./.github/actions/bindist-actions/action-deb10 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: BINDIST - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: bindist-x86_64-linux-deb10 + name: bindist-x86_64-linux-deb11 path: |- ./out/*.tar.xz ./out/plan.json/* ./out/*.zip retention-days: 2 - bindist-x86_64-linux-deb11: + bindist-x86_64-linux-deb12: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive S3_HOST: ${{ secrets.S3_HOST }} TARBALL_EXT: tar.xz TZ: Asia/Singapore - name: bindist-x86_64-linux-deb11 (Prepare bindist) + name: bindist-x86_64-linux-deb12 (Prepare bindist) needs: - - build-x86_64-linux-deb11-948 - - build-x86_64-linux-deb11-967 - - build-x86_64-linux-deb11-984 - - build-x86_64-linux-deb11-9101 - - build-x86_64-linux-deb11-9122 + - build-x86_64-linux-deb12-967 + - build-x86_64-linux-deb12-984 + - build-x86_64-linux-deb12-9102 + - build-x86_64-linux-deb12-9122 runs-on: - self-hosted - linux-space @@ -311,37 +286,32 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb11-948 - path: ./ - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-deb11-967 + name: artifacts-build-x86_64-linux-deb12-967 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb11-984 + name: artifacts-build-x86_64-linux-deb12-984 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb11-9101 + name: artifacts-build-x86_64-linux-deb12-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb11-9122 + name: artifacts-build-x86_64-linux-deb12-9122 path: ./ - name: Bindist - uses: ./.github/actions/bindist-actions/action-deb11 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: BINDIST - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: bindist-x86_64-linux-deb11 + name: bindist-x86_64-linux-deb12 path: |- ./out/*.tar.xz ./out/plan.json/* @@ -360,10 +330,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-deb9 (Prepare bindist) needs: - - build-x86_64-linux-deb9-948 - build-x86_64-linux-deb9-967 - build-x86_64-linux-deb9-984 - - build-x86_64-linux-deb9-9101 + - build-x86_64-linux-deb9-9102 - build-x86_64-linux-deb9-9122 runs-on: - self-hosted @@ -372,11 +341,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-deb9-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -390,7 +354,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-deb9-9101 + name: artifacts-build-x86_64-linux-deb9-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -411,24 +375,23 @@ jobs: ./out/plan.json/* ./out/*.zip retention-days: 2 - bindist-x86_64-linux-fedora27: + bindist-x86_64-linux-fedora33: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive S3_HOST: ${{ secrets.S3_HOST }} TARBALL_EXT: tar.xz TZ: Asia/Singapore - name: bindist-x86_64-linux-fedora27 (Prepare bindist) + name: bindist-x86_64-linux-fedora33 (Prepare bindist) needs: - - build-x86_64-linux-fedora27-948 - - build-x86_64-linux-fedora27-967 - - build-x86_64-linux-fedora27-984 - - build-x86_64-linux-fedora27-9101 - - build-x86_64-linux-fedora27-9122 + - build-x86_64-linux-fedora33-967 + - build-x86_64-linux-fedora33-984 + - build-x86_64-linux-fedora33-9102 + - build-x86_64-linux-fedora33-9122 runs-on: - self-hosted - linux-space @@ -439,60 +402,54 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora27-948 - path: ./ - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-fedora27-967 + name: artifacts-build-x86_64-linux-fedora33-967 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora27-984 + name: artifacts-build-x86_64-linux-fedora33-984 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora27-9101 + name: artifacts-build-x86_64-linux-fedora33-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora27-9122 + name: artifacts-build-x86_64-linux-fedora33-9122 path: ./ - name: Bindist - uses: ./.github/actions/bindist-actions/action-fedora27 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: BINDIST - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: bindist-x86_64-linux-fedora27 + name: bindist-x86_64-linux-fedora33 path: |- ./out/*.tar.xz ./out/plan.json/* ./out/*.zip retention-days: 2 - bindist-x86_64-linux-fedora33: + bindist-x86_64-linux-fedora40: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive S3_HOST: ${{ secrets.S3_HOST }} TARBALL_EXT: tar.xz TZ: Asia/Singapore - name: bindist-x86_64-linux-fedora33 (Prepare bindist) + name: bindist-x86_64-linux-fedora40 (Prepare bindist) needs: - - build-x86_64-linux-fedora33-948 - - build-x86_64-linux-fedora33-967 - - build-x86_64-linux-fedora33-984 - - build-x86_64-linux-fedora33-9101 - - build-x86_64-linux-fedora33-9122 + - build-x86_64-linux-fedora40-967 + - build-x86_64-linux-fedora40-984 + - build-x86_64-linux-fedora40-9102 + - build-x86_64-linux-fedora40-9122 runs-on: - self-hosted - linux-space @@ -503,37 +460,32 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora33-948 - path: ./ - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-fedora33-967 + name: artifacts-build-x86_64-linux-fedora40-967 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora33-984 + name: artifacts-build-x86_64-linux-fedora40-984 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora33-9101 + name: artifacts-build-x86_64-linux-fedora40-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-fedora33-9122 + name: artifacts-build-x86_64-linux-fedora40-9122 path: ./ - name: Bindist - uses: ./.github/actions/bindist-actions/action-fedora33 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: BINDIST - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: bindist-x86_64-linux-fedora33 + name: bindist-x86_64-linux-fedora40 path: |- ./out/*.tar.xz ./out/plan.json/* @@ -552,10 +504,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-mint193 (Prepare bindist) needs: - - build-x86_64-linux-mint193-948 - build-x86_64-linux-mint193-967 - build-x86_64-linux-mint193-984 - - build-x86_64-linux-mint193-9101 + - build-x86_64-linux-mint193-9102 - build-x86_64-linux-mint193-9122 runs-on: - self-hosted @@ -564,11 +515,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-mint193-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -582,7 +528,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-mint193-9101 + name: artifacts-build-x86_64-linux-mint193-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -616,10 +562,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-mint202 (Prepare bindist) needs: - - build-x86_64-linux-mint202-948 - build-x86_64-linux-mint202-967 - build-x86_64-linux-mint202-984 - - build-x86_64-linux-mint202-9101 + - build-x86_64-linux-mint202-9102 - build-x86_64-linux-mint202-9122 runs-on: - self-hosted @@ -628,11 +573,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-mint202-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -646,7 +586,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-mint202-9101 + name: artifacts-build-x86_64-linux-mint202-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -667,6 +607,64 @@ jobs: ./out/plan.json/* ./out/*.zip retention-days: 2 + bindist-x86_64-linux-mint213: + env: + ADD_CABAL_ARGS: --enable-split-sections + ARCH: '64' + ARTIFACT: x86_64-linux-mint213 + AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} + DEBIAN_FRONTEND: noninteractive + S3_HOST: ${{ secrets.S3_HOST }} + TARBALL_EXT: tar.xz + TZ: Asia/Singapore + name: bindist-x86_64-linux-mint213 (Prepare bindist) + needs: + - build-x86_64-linux-mint213-967 + - build-x86_64-linux-mint213-984 + - build-x86_64-linux-mint213-9102 + - build-x86_64-linux-mint213-9122 + runs-on: + - self-hosted + - linux-space + - maerwald + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: artifacts-build-x86_64-linux-mint213-967 + path: ./ + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: artifacts-build-x86_64-linux-mint213-984 + path: ./ + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: artifacts-build-x86_64-linux-mint213-9102 + path: ./ + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: artifacts-build-x86_64-linux-mint213-9122 + path: ./ + - name: Bindist + uses: ./.github/actions/bindist-actions/action-mint213 + with: + stage: BINDIST + - name: Upload artifact + uses: actions/upload-artifact@v4 + with: + if-no-files-found: error + name: bindist-x86_64-linux-mint213 + path: |- + ./out/*.tar.xz + ./out/plan.json/* + ./out/*.zip + retention-days: 2 bindist-x86_64-linux-ubuntu1804: env: ADD_CABAL_ARGS: --enable-split-sections @@ -680,10 +678,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-ubuntu1804 (Prepare bindist) needs: - - build-x86_64-linux-ubuntu1804-948 - build-x86_64-linux-ubuntu1804-967 - build-x86_64-linux-ubuntu1804-984 - - build-x86_64-linux-ubuntu1804-9101 + - build-x86_64-linux-ubuntu1804-9102 - build-x86_64-linux-ubuntu1804-9122 runs-on: - self-hosted @@ -692,11 +689,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-ubuntu1804-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -710,7 +702,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-ubuntu1804-9101 + name: artifacts-build-x86_64-linux-ubuntu1804-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -744,10 +736,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-ubuntu2004 (Prepare bindist) needs: - - build-x86_64-linux-ubuntu2004-948 - build-x86_64-linux-ubuntu2004-967 - build-x86_64-linux-ubuntu2004-984 - - build-x86_64-linux-ubuntu2004-9101 + - build-x86_64-linux-ubuntu2004-9102 - build-x86_64-linux-ubuntu2004-9122 runs-on: - self-hosted @@ -756,11 +747,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-ubuntu2004-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -774,7 +760,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-ubuntu2004-9101 + name: artifacts-build-x86_64-linux-ubuntu2004-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -808,10 +794,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-ubuntu2204 (Prepare bindist) needs: - - build-x86_64-linux-ubuntu2204-948 - build-x86_64-linux-ubuntu2204-967 - build-x86_64-linux-ubuntu2204-984 - - build-x86_64-linux-ubuntu2204-9101 + - build-x86_64-linux-ubuntu2204-9102 - build-x86_64-linux-ubuntu2204-9122 runs-on: - self-hosted @@ -820,11 +805,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-ubuntu2204-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -838,7 +818,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-ubuntu2204-9101 + name: artifacts-build-x86_64-linux-ubuntu2204-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -872,10 +852,9 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-linux-unknown (Prepare bindist) needs: - - build-x86_64-linux-unknown-948 - build-x86_64-linux-unknown-967 - build-x86_64-linux-unknown-984 - - build-x86_64-linux-unknown-9101 + - build-x86_64-linux-unknown-9102 - build-x86_64-linux-unknown-9122 runs-on: - self-hosted @@ -884,11 +863,6 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-linux-unknown-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -902,7 +876,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-linux-unknown-9101 + name: artifacts-build-x86_64-linux-unknown-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -936,21 +910,15 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-mac (Prepare bindist) needs: - - build-x86_64-mac-948 - build-x86_64-mac-967 - build-x86_64-mac-984 - - build-x86_64-mac-9101 + - build-x86_64-mac-9102 - build-x86_64-mac-9122 runs-on: - macOS-13 steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-mac-948 - path: ./ - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -964,7 +932,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-mac-9101 + name: artifacts-build-x86_64-mac-9102 path: ./ - name: Download artifacts uses: actions/download-artifact@v4 @@ -1002,21 +970,15 @@ jobs: TZ: Asia/Singapore name: bindist-x86_64-windows (Prepare bindist) needs: - - build-x86_64-windows-948 - build-x86_64-windows-967 - build-x86_64-windows-984 - - build-x86_64-windows-9101 + - build-x86_64-windows-9102 - build-x86_64-windows-9122 runs-on: - windows-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Download artifacts - uses: actions/download-artifact@v4 - with: - name: artifacts-build-x86_64-windows-948 - path: ./out - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -1030,7 +992,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: artifacts-build-x86_64-windows-9101 + name: artifacts-build-x86_64-windows-9102 path: ./out - name: Download artifacts uses: actions/download-artifact@v4 @@ -1057,7 +1019,7 @@ jobs: ./out/plan.json/* ./out/*.zip retention-days: 2 - build-aarch64-linux-ubuntu2004-9101: + build-aarch64-linux-ubuntu2004-9102: env: ADD_CABAL_ARGS: '' ARCH: ARM64 @@ -1069,7 +1031,7 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-aarch64-linux-ubuntu2004-9101 (Build binaries) + name: build-aarch64-linux-ubuntu2004-9102 (Build binaries) runs-on: - self-hosted - Linux @@ -1084,13 +1046,13 @@ jobs: - name: Checkout uses: actions/checkout@v4 - env: - GHC_VERSION: 9.10.1 + GHC_VERSION: 9.10.2 name: Build aarch64-linux binaries uses: docker://hasufell/arm64v8-ubuntu-haskell:focal with: args: bash .github/scripts/build.sh - env: - GHC_VERSION: 9.10.1 + GHC_VERSION: 9.10.2 name: Tar aarch64-linux binaries uses: docker://hasufell/arm64v8-ubuntu-haskell:focal with: @@ -1099,8 +1061,8 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-aarch64-linux-ubuntu2004-9101 - path: out-aarch64-linux-ubuntu2004-9.10.1.tar + name: artifacts-build-aarch64-linux-ubuntu2004-9102 + path: out-aarch64-linux-ubuntu2004-9.10.2.tar retention-days: 2 build-aarch64-linux-ubuntu2004-9122: env: @@ -1147,51 +1109,6 @@ jobs: name: artifacts-build-aarch64-linux-ubuntu2004-9122 path: out-aarch64-linux-ubuntu2004-9.12.2.tar retention-days: 2 - build-aarch64-linux-ubuntu2004-948: - env: - ADD_CABAL_ARGS: '' - ARCH: ARM64 - ARTIFACT: aarch64-linux-ubuntu2004 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-aarch64-linux-ubuntu2004-948 (Build binaries) - runs-on: - - self-hosted - - Linux - - ARM64 - - maerwald - steps: - - name: clean and git config for aarch64-linux - run: | - find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} + - git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*" - shell: bash - - name: Checkout - uses: actions/checkout@v4 - - env: - GHC_VERSION: 9.4.8 - name: Build aarch64-linux binaries - uses: docker://hasufell/arm64v8-ubuntu-haskell:focal - with: - args: bash .github/scripts/build.sh - - env: - GHC_VERSION: 9.4.8 - name: Tar aarch64-linux binaries - uses: docker://hasufell/arm64v8-ubuntu-haskell:focal - with: - args: bash .github/scripts/tar.sh - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-aarch64-linux-ubuntu2004-948 - path: out-aarch64-linux-ubuntu2004-9.4.8.tar - retention-days: 2 build-aarch64-linux-ubuntu2004-967: env: ADD_CABAL_ARGS: '' @@ -1282,7 +1199,7 @@ jobs: name: artifacts-build-aarch64-linux-ubuntu2004-984 path: out-aarch64-linux-ubuntu2004-9.8.4.tar retention-days: 2 - build-aarch64-mac-9101: + build-aarch64-mac-9102: env: ADD_CABAL_ARGS: '' ARCH: ARM64 @@ -1295,7 +1212,7 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-aarch64-mac-9101 (Build binaries) + name: build-aarch64-mac-9102 (Build binaries) runs-on: - self-hosted - macOS @@ -1304,7 +1221,7 @@ jobs: - name: Checkout uses: actions/checkout@v4 - env: - GHC_VERSION: 9.10.1 + GHC_VERSION: 9.10.2 name: Run build run: | bash .github/scripts/brew.sh git coreutils autoconf automake tree @@ -1317,8 +1234,8 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-aarch64-mac-9101 - path: out-aarch64-apple-darwin-9.10.1.tar + name: artifacts-build-aarch64-mac-9102 + path: out-aarch64-apple-darwin-9.10.2.tar retention-days: 2 build-aarch64-mac-9122: env: @@ -1358,44 +1275,6 @@ jobs: name: artifacts-build-aarch64-mac-9122 path: out-aarch64-apple-darwin-9.12.2.tar retention-days: 2 - build-aarch64-mac-948: - env: - ADD_CABAL_ARGS: '' - ARCH: ARM64 - ARTIFACT: aarch64-apple-darwin - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - HOMEBREW_CHANGE_ARCH_TO_ARM: '1' - MACOSX_DEPLOYMENT_TARGET: '10.13' - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-aarch64-mac-948 (Build binaries) - runs-on: - - self-hosted - - macOS - - ARM64 - steps: - - name: Checkout - uses: actions/checkout@v4 - - env: - GHC_VERSION: 9.4.8 - name: Run build - run: | - bash .github/scripts/brew.sh git coreutils autoconf automake tree - export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH" - export LD=ld - bash .github/scripts/build.sh - tar cf out-${ARTIFACT}-${GHC_VERSION}.tar out/ store/ - shell: sh - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-aarch64-mac-948 - path: out-aarch64-apple-darwin-9.4.8.tar - retention-days: 2 build-aarch64-mac-967: env: ADD_CABAL_ARGS: '' @@ -1472,11 +1351,11 @@ jobs: name: artifacts-build-aarch64-mac-984 path: out-aarch64-apple-darwin-9.8.4.tar retention-days: 2 - build-x86_64-linux-centos7-9101: + build-x86_64-linux-deb10-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1484,29 +1363,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-centos7-9101 (Build binaries) + name: build-x86_64-linux-deb10-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-centos7 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-centos7-9101 - path: out-x86_64-linux-centos7-9.10.1.tar + name: artifacts-build-x86_64-linux-deb10-9102 + path: out-x86_64-linux-deb10-9.10.2.tar retention-days: 2 - build-x86_64-linux-centos7-9122: + build-x86_64-linux-deb10-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1514,14 +1393,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-centos7-9122 (Build binaries) + name: build-x86_64-linux-deb10-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.12.2 - uses: ./.github/actions/bindist-actions/action-centos7 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: BUILD version: 9.12.2 @@ -1529,44 +1408,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-centos7-9122 - path: out-x86_64-linux-centos7-9.12.2.tar + name: artifacts-build-x86_64-linux-deb10-9122 + path: out-x86_64-linux-deb10-9.12.2.tar retention-days: 2 - build-x86_64-linux-centos7-948: + build-x86_64-linux-deb10-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-centos7-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-centos7 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-centos7-948 - path: out-x86_64-linux-centos7-9.4.8.tar - retention-days: 2 - build-x86_64-linux-centos7-967: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1574,14 +1423,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-centos7-967 (Build binaries) + name: build-x86_64-linux-deb10-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-centos7 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: BUILD version: 9.6.7 @@ -1589,14 +1438,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-centos7-967 - path: out-x86_64-linux-centos7-9.6.7.tar + name: artifacts-build-x86_64-linux-deb10-967 + path: out-x86_64-linux-deb10-9.6.7.tar retention-days: 2 - build-x86_64-linux-centos7-984: + build-x86_64-linux-deb10-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1604,14 +1453,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-centos7-984 (Build binaries) + name: build-x86_64-linux-deb10-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-centos7 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: BUILD version: 9.8.4 @@ -1619,14 +1468,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-centos7-984 - path: out-x86_64-linux-centos7-9.8.4.tar + name: artifacts-build-x86_64-linux-deb10-984 + path: out-x86_64-linux-deb10-9.8.4.tar retention-days: 2 - build-x86_64-linux-deb10-9101: + build-x86_64-linux-deb11-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1634,29 +1483,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb10-9101 (Build binaries) + name: build-x86_64-linux-deb11-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-deb10 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb10-9101 - path: out-x86_64-linux-deb10-9.10.1.tar + name: artifacts-build-x86_64-linux-deb11-9102 + path: out-x86_64-linux-deb11-9.10.2.tar retention-days: 2 - build-x86_64-linux-deb10-9122: + build-x86_64-linux-deb11-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1664,14 +1513,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb10-9122 (Build binaries) + name: build-x86_64-linux-deb11-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.12.2 - uses: ./.github/actions/bindist-actions/action-deb10 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: BUILD version: 9.12.2 @@ -1679,44 +1528,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb10-9122 - path: out-x86_64-linux-deb10-9.12.2.tar - retention-days: 2 - build-x86_64-linux-deb10-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-deb10 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-deb10-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-deb10 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-deb10-948 - path: out-x86_64-linux-deb10-9.4.8.tar + name: artifacts-build-x86_64-linux-deb11-9122 + path: out-x86_64-linux-deb11-9.12.2.tar retention-days: 2 - build-x86_64-linux-deb10-967: + build-x86_64-linux-deb11-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1724,14 +1543,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb10-967 (Build binaries) + name: build-x86_64-linux-deb11-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-deb10 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: BUILD version: 9.6.7 @@ -1739,14 +1558,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb10-967 - path: out-x86_64-linux-deb10-9.6.7.tar + name: artifacts-build-x86_64-linux-deb11-967 + path: out-x86_64-linux-deb11-9.6.7.tar retention-days: 2 - build-x86_64-linux-deb10-984: + build-x86_64-linux-deb11-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1754,14 +1573,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb10-984 (Build binaries) + name: build-x86_64-linux-deb11-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-deb10 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: BUILD version: 9.8.4 @@ -1769,14 +1588,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb10-984 - path: out-x86_64-linux-deb10-9.8.4.tar + name: artifacts-build-x86_64-linux-deb11-984 + path: out-x86_64-linux-deb11-9.8.4.tar retention-days: 2 - build-x86_64-linux-deb11-9101: + build-x86_64-linux-deb12-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1784,29 +1603,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb11-9101 (Build binaries) + name: build-x86_64-linux-deb12-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-deb11 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb11-9101 - path: out-x86_64-linux-deb11-9.10.1.tar + name: artifacts-build-x86_64-linux-deb12-9102 + path: out-x86_64-linux-deb12-9.10.2.tar retention-days: 2 - build-x86_64-linux-deb11-9122: + build-x86_64-linux-deb12-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1814,14 +1633,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb11-9122 (Build binaries) + name: build-x86_64-linux-deb12-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.12.2 - uses: ./.github/actions/bindist-actions/action-deb11 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: BUILD version: 9.12.2 @@ -1829,44 +1648,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb11-9122 - path: out-x86_64-linux-deb11-9.12.2.tar - retention-days: 2 - build-x86_64-linux-deb11-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-deb11 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-deb11-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-deb11 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-deb11-948 - path: out-x86_64-linux-deb11-9.4.8.tar + name: artifacts-build-x86_64-linux-deb12-9122 + path: out-x86_64-linux-deb12-9.12.2.tar retention-days: 2 - build-x86_64-linux-deb11-967: + build-x86_64-linux-deb12-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1874,14 +1663,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb11-967 (Build binaries) + name: build-x86_64-linux-deb12-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-deb11 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: BUILD version: 9.6.7 @@ -1889,14 +1678,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb11-967 - path: out-x86_64-linux-deb11-9.6.7.tar + name: artifacts-build-x86_64-linux-deb12-967 + path: out-x86_64-linux-deb12-9.6.7.tar retention-days: 2 - build-x86_64-linux-deb11-984: + build-x86_64-linux-deb12-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -1904,14 +1693,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb11-984 (Build binaries) + name: build-x86_64-linux-deb12-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-deb11 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: BUILD version: 9.8.4 @@ -1919,10 +1708,10 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb11-984 - path: out-x86_64-linux-deb11-9.8.4.tar + name: artifacts-build-x86_64-linux-deb12-984 + path: out-x86_64-linux-deb12-9.8.4.tar retention-days: 2 - build-x86_64-linux-deb9-9101: + build-x86_64-linux-deb9-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -1934,23 +1723,23 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-deb9-9101 (Build binaries) + name: build-x86_64-linux-deb9-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.10.2 uses: ./.github/actions/bindist-actions/action-deb9 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-deb9-9101 - path: out-x86_64-linux-deb9-9.10.1.tar + name: artifacts-build-x86_64-linux-deb9-9102 + path: out-x86_64-linux-deb9-9.10.2.tar retention-days: 2 build-x86_64-linux-deb9-9122: env: @@ -1982,36 +1771,6 @@ jobs: name: artifacts-build-x86_64-linux-deb9-9122 path: out-x86_64-linux-deb9-9.12.2.tar retention-days: 2 - build-x86_64-linux-deb9-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-deb9 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-deb9-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-deb9 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-deb9-948 - path: out-x86_64-linux-deb9-9.4.8.tar - retention-days: 2 build-x86_64-linux-deb9-967: env: ADD_CABAL_ARGS: --enable-split-sections @@ -2072,11 +1831,11 @@ jobs: name: artifacts-build-x86_64-linux-deb9-984 path: out-x86_64-linux-deb9-9.8.4.tar retention-days: 2 - build-x86_64-linux-fedora27-9101: + build-x86_64-linux-fedora33-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2084,29 +1843,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora27-9101 (Build binaries) + name: build-x86_64-linux-fedora33-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-fedora27 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora27-9101 - path: out-x86_64-linux-fedora27-9.10.1.tar + name: artifacts-build-x86_64-linux-fedora33-9102 + path: out-x86_64-linux-fedora33-9.10.2.tar retention-days: 2 - build-x86_64-linux-fedora27-9122: + build-x86_64-linux-fedora33-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2114,14 +1873,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora27-9122 (Build binaries) + name: build-x86_64-linux-fedora33-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.12.2 - uses: ./.github/actions/bindist-actions/action-fedora27 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: BUILD version: 9.12.2 @@ -2129,44 +1888,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora27-9122 - path: out-x86_64-linux-fedora27-9.12.2.tar - retention-days: 2 - build-x86_64-linux-fedora27-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-fedora27-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-fedora27 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora27-948 - path: out-x86_64-linux-fedora27-9.4.8.tar + name: artifacts-build-x86_64-linux-fedora33-9122 + path: out-x86_64-linux-fedora33-9.12.2.tar retention-days: 2 - build-x86_64-linux-fedora27-967: + build-x86_64-linux-fedora33-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2174,14 +1903,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora27-967 (Build binaries) + name: build-x86_64-linux-fedora33-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-fedora27 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: BUILD version: 9.6.7 @@ -2189,14 +1918,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora27-967 - path: out-x86_64-linux-fedora27-9.6.7.tar + name: artifacts-build-x86_64-linux-fedora33-967 + path: out-x86_64-linux-fedora33-9.6.7.tar retention-days: 2 - build-x86_64-linux-fedora27-984: + build-x86_64-linux-fedora33-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2204,14 +1933,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora27-984 (Build binaries) + name: build-x86_64-linux-fedora33-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-fedora27 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: BUILD version: 9.8.4 @@ -2219,14 +1948,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora27-984 - path: out-x86_64-linux-fedora27-9.8.4.tar + name: artifacts-build-x86_64-linux-fedora33-984 + path: out-x86_64-linux-fedora33-9.8.4.tar retention-days: 2 - build-x86_64-linux-fedora33-9101: + build-x86_64-linux-fedora40-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2234,29 +1963,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora33-9101 (Build binaries) + name: build-x86_64-linux-fedora40-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-fedora33 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora33-9101 - path: out-x86_64-linux-fedora33-9.10.1.tar + name: artifacts-build-x86_64-linux-fedora40-9102 + path: out-x86_64-linux-fedora40-9.10.2.tar retention-days: 2 - build-x86_64-linux-fedora33-9122: + build-x86_64-linux-fedora40-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2264,14 +1993,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora33-9122 (Build binaries) + name: build-x86_64-linux-fedora40-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - name: Build 9.12.2 - uses: ./.github/actions/bindist-actions/action-fedora33 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: BUILD version: 9.12.2 @@ -2279,14 +2008,14 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora33-9122 - path: out-x86_64-linux-fedora33-9.12.2.tar + name: artifacts-build-x86_64-linux-fedora40-9122 + path: out-x86_64-linux-fedora40-9.12.2.tar retention-days: 2 - build-x86_64-linux-fedora33-948: + build-x86_64-linux-fedora40-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2294,29 +2023,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora33-948 (Build binaries) + name: build-x86_64-linux-fedora40-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-fedora33 + - name: Build 9.6.7 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: BUILD - version: 9.4.8 + version: 9.6.7 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora33-948 - path: out-x86_64-linux-fedora33-9.4.8.tar + name: artifacts-build-x86_64-linux-fedora40-967 + path: out-x86_64-linux-fedora40-9.6.7.tar retention-days: 2 - build-x86_64-linux-fedora33-967: + build-x86_64-linux-fedora40-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2324,29 +2053,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora33-967 (Build binaries) + name: build-x86_64-linux-fedora40-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-fedora33 + - name: Build 9.8.4 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: BUILD - version: 9.6.7 + version: 9.8.4 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora33-967 - path: out-x86_64-linux-fedora33-9.6.7.tar + name: artifacts-build-x86_64-linux-fedora40-984 + path: out-x86_64-linux-fedora40-9.8.4.tar retention-days: 2 - build-x86_64-linux-fedora33-984: + build-x86_64-linux-mint193-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-mint193 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2354,25 +2083,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-fedora33-984 (Build binaries) + name: build-x86_64-linux-mint193-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-fedora33 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-mint193 with: stage: BUILD - version: 9.8.4 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-fedora33-984 - path: out-x86_64-linux-fedora33-9.8.4.tar + name: artifacts-build-x86_64-linux-mint193-9102 + path: out-x86_64-linux-mint193-9.10.2.tar retention-days: 2 - build-x86_64-linux-mint193-9101: + build-x86_64-linux-mint193-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2384,25 +2113,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint193-9101 (Build binaries) + name: build-x86_64-linux-mint193-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.12.2 uses: ./.github/actions/bindist-actions/action-mint193 with: stage: BUILD - version: 9.10.1 + version: 9.12.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint193-9101 - path: out-x86_64-linux-mint193-9.10.1.tar + name: artifacts-build-x86_64-linux-mint193-9122 + path: out-x86_64-linux-mint193-9.12.2.tar retention-days: 2 - build-x86_64-linux-mint193-9122: + build-x86_64-linux-mint193-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2414,25 +2143,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint193-9122 (Build binaries) + name: build-x86_64-linux-mint193-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.12.2 + - name: Build 9.6.7 uses: ./.github/actions/bindist-actions/action-mint193 with: stage: BUILD - version: 9.12.2 + version: 9.6.7 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint193-9122 - path: out-x86_64-linux-mint193-9.12.2.tar + name: artifacts-build-x86_64-linux-mint193-967 + path: out-x86_64-linux-mint193-9.6.7.tar retention-days: 2 - build-x86_64-linux-mint193-948: + build-x86_64-linux-mint193-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2444,29 +2173,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint193-948 (Build binaries) + name: build-x86_64-linux-mint193-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.4.8 + - name: Build 9.8.4 uses: ./.github/actions/bindist-actions/action-mint193 with: stage: BUILD - version: 9.4.8 + version: 9.8.4 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint193-948 - path: out-x86_64-linux-mint193-9.4.8.tar + name: artifacts-build-x86_64-linux-mint193-984 + path: out-x86_64-linux-mint193-9.8.4.tar retention-days: 2 - build-x86_64-linux-mint193-967: + build-x86_64-linux-mint202-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-mint193 + ARTIFACT: x86_64-linux-mint202 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2474,29 +2203,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint193-967 (Build binaries) + name: build-x86_64-linux-mint202-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-mint193 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-mint202 with: stage: BUILD - version: 9.6.7 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint193-967 - path: out-x86_64-linux-mint193-9.6.7.tar + name: artifacts-build-x86_64-linux-mint202-9102 + path: out-x86_64-linux-mint202-9.10.2.tar retention-days: 2 - build-x86_64-linux-mint193-984: + build-x86_64-linux-mint202-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-mint193 + ARTIFACT: x86_64-linux-mint202 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2504,25 +2233,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint193-984 (Build binaries) + name: build-x86_64-linux-mint202-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-mint193 + - name: Build 9.12.2 + uses: ./.github/actions/bindist-actions/action-mint202 with: stage: BUILD - version: 9.8.4 + version: 9.12.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint193-984 - path: out-x86_64-linux-mint193-9.8.4.tar + name: artifacts-build-x86_64-linux-mint202-9122 + path: out-x86_64-linux-mint202-9.12.2.tar retention-days: 2 - build-x86_64-linux-mint202-9101: + build-x86_64-linux-mint202-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2534,25 +2263,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint202-9101 (Build binaries) + name: build-x86_64-linux-mint202-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.6.7 uses: ./.github/actions/bindist-actions/action-mint202 with: stage: BUILD - version: 9.10.1 + version: 9.6.7 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint202-9101 - path: out-x86_64-linux-mint202-9.10.1.tar + name: artifacts-build-x86_64-linux-mint202-967 + path: out-x86_64-linux-mint202-9.6.7.tar retention-days: 2 - build-x86_64-linux-mint202-9122: + build-x86_64-linux-mint202-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2564,29 +2293,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint202-9122 (Build binaries) + name: build-x86_64-linux-mint202-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.12.2 + - name: Build 9.8.4 uses: ./.github/actions/bindist-actions/action-mint202 with: stage: BUILD - version: 9.12.2 + version: 9.8.4 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint202-9122 - path: out-x86_64-linux-mint202-9.12.2.tar + name: artifacts-build-x86_64-linux-mint202-984 + path: out-x86_64-linux-mint202-9.8.4.tar retention-days: 2 - build-x86_64-linux-mint202-948: + build-x86_64-linux-mint213-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-mint202 + ARTIFACT: x86_64-linux-mint213 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2594,29 +2323,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint202-948 (Build binaries) + name: build-x86_64-linux-mint213-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-mint202 + - name: Build 9.10.2 + uses: ./.github/actions/bindist-actions/action-mint213 with: stage: BUILD - version: 9.4.8 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint202-948 - path: out-x86_64-linux-mint202-9.4.8.tar + name: artifacts-build-x86_64-linux-mint213-9102 + path: out-x86_64-linux-mint213-9.10.2.tar retention-days: 2 - build-x86_64-linux-mint202-967: + build-x86_64-linux-mint213-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-mint202 + ARTIFACT: x86_64-linux-mint213 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2624,29 +2353,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint202-967 (Build binaries) + name: build-x86_64-linux-mint213-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.6.7 - uses: ./.github/actions/bindist-actions/action-mint202 + - name: Build 9.12.2 + uses: ./.github/actions/bindist-actions/action-mint213 with: stage: BUILD - version: 9.6.7 + version: 9.12.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint202-967 - path: out-x86_64-linux-mint202-9.6.7.tar + name: artifacts-build-x86_64-linux-mint213-9122 + path: out-x86_64-linux-mint213-9.12.2.tar retention-days: 2 - build-x86_64-linux-mint202-984: + build-x86_64-linux-mint213-967: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-mint202 + ARTIFACT: x86_64-linux-mint213 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2654,29 +2383,29 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-mint202-984 (Build binaries) + name: build-x86_64-linux-mint213-967 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.8.4 - uses: ./.github/actions/bindist-actions/action-mint202 + - name: Build 9.6.7 + uses: ./.github/actions/bindist-actions/action-mint213 with: stage: BUILD - version: 9.8.4 + version: 9.6.7 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-mint202-984 - path: out-x86_64-linux-mint202-9.8.4.tar + name: artifacts-build-x86_64-linux-mint213-967 + path: out-x86_64-linux-mint213-9.6.7.tar retention-days: 2 - build-x86_64-linux-ubuntu1804-9101: + build-x86_64-linux-mint213-984: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-ubuntu1804 + ARTIFACT: x86_64-linux-mint213 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -2684,25 +2413,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-ubuntu1804-9101 (Build binaries) + name: build-x86_64-linux-mint213-984 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 - uses: ./.github/actions/bindist-actions/action-ubuntu1804 + - name: Build 9.8.4 + uses: ./.github/actions/bindist-actions/action-mint213 with: stage: BUILD - version: 9.10.1 + version: 9.8.4 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu1804-9101 - path: out-x86_64-linux-ubuntu1804-9.10.1.tar + name: artifacts-build-x86_64-linux-mint213-984 + path: out-x86_64-linux-mint213-9.8.4.tar retention-days: 2 - build-x86_64-linux-ubuntu1804-9122: + build-x86_64-linux-ubuntu1804-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2714,25 +2443,25 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-ubuntu1804-9122 (Build binaries) + name: build-x86_64-linux-ubuntu1804-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.12.2 + - name: Build 9.10.2 uses: ./.github/actions/bindist-actions/action-ubuntu1804 with: stage: BUILD - version: 9.12.2 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu1804-9122 - path: out-x86_64-linux-ubuntu1804-9.12.2.tar + name: artifacts-build-x86_64-linux-ubuntu1804-9102 + path: out-x86_64-linux-ubuntu1804-9.10.2.tar retention-days: 2 - build-x86_64-linux-ubuntu1804-948: + build-x86_64-linux-ubuntu1804-9122: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2744,23 +2473,23 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-ubuntu1804-948 (Build binaries) + name: build-x86_64-linux-ubuntu1804-9122 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.4.8 + - name: Build 9.12.2 uses: ./.github/actions/bindist-actions/action-ubuntu1804 with: stage: BUILD - version: 9.4.8 + version: 9.12.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu1804-948 - path: out-x86_64-linux-ubuntu1804-9.4.8.tar + name: artifacts-build-x86_64-linux-ubuntu1804-9122 + path: out-x86_64-linux-ubuntu1804-9.12.2.tar retention-days: 2 build-x86_64-linux-ubuntu1804-967: env: @@ -2822,7 +2551,7 @@ jobs: name: artifacts-build-x86_64-linux-ubuntu1804-984 path: out-x86_64-linux-ubuntu1804-9.8.4.tar retention-days: 2 - build-x86_64-linux-ubuntu2004-9101: + build-x86_64-linux-ubuntu2004-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2834,23 +2563,23 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-ubuntu2004-9101 (Build binaries) + name: build-x86_64-linux-ubuntu2004-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.10.2 uses: ./.github/actions/bindist-actions/action-ubuntu2004 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu2004-9101 - path: out-x86_64-linux-ubuntu2004-9.10.1.tar + name: artifacts-build-x86_64-linux-ubuntu2004-9102 + path: out-x86_64-linux-ubuntu2004-9.10.2.tar retention-days: 2 build-x86_64-linux-ubuntu2004-9122: env: @@ -2882,36 +2611,6 @@ jobs: name: artifacts-build-x86_64-linux-ubuntu2004-9122 path: out-x86_64-linux-ubuntu2004-9.12.2.tar retention-days: 2 - build-x86_64-linux-ubuntu2004-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-ubuntu2004 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-ubuntu2004-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-ubuntu2004 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu2004-948 - path: out-x86_64-linux-ubuntu2004-9.4.8.tar - retention-days: 2 build-x86_64-linux-ubuntu2004-967: env: ADD_CABAL_ARGS: --enable-split-sections @@ -2972,7 +2671,7 @@ jobs: name: artifacts-build-x86_64-linux-ubuntu2004-984 path: out-x86_64-linux-ubuntu2004-9.8.4.tar retention-days: 2 - build-x86_64-linux-ubuntu2204-9101: + build-x86_64-linux-ubuntu2204-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -2984,23 +2683,23 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-ubuntu2204-9101 (Build binaries) + name: build-x86_64-linux-ubuntu2204-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.10.2 uses: ./.github/actions/bindist-actions/action-ubuntu2204 with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu2204-9101 - path: out-x86_64-linux-ubuntu2204-9.10.1.tar + name: artifacts-build-x86_64-linux-ubuntu2204-9102 + path: out-x86_64-linux-ubuntu2204-9.10.2.tar retention-days: 2 build-x86_64-linux-ubuntu2204-9122: env: @@ -3032,36 +2731,6 @@ jobs: name: artifacts-build-x86_64-linux-ubuntu2204-9122 path: out-x86_64-linux-ubuntu2204-9.12.2.tar retention-days: 2 - build-x86_64-linux-ubuntu2204-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-ubuntu2204 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-ubuntu2204-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-ubuntu2204 - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-ubuntu2204-948 - path: out-x86_64-linux-ubuntu2204-9.4.8.tar - retention-days: 2 build-x86_64-linux-ubuntu2204-967: env: ADD_CABAL_ARGS: --enable-split-sections @@ -3122,7 +2791,7 @@ jobs: name: artifacts-build-x86_64-linux-ubuntu2204-984 path: out-x86_64-linux-ubuntu2204-9.8.4.tar retention-days: 2 - build-x86_64-linux-unknown-9101: + build-x86_64-linux-unknown-9102: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' @@ -3134,23 +2803,23 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-linux-unknown-9101 (Build binaries) + name: build-x86_64-linux-unknown-9102 (Build binaries) runs-on: - ubuntu-latest steps: - name: Checkout uses: actions/checkout@v4 - - name: Build 9.10.1 + - name: Build 9.10.2 uses: ./.github/actions/bindist-actions/action-unknown with: stage: BUILD - version: 9.10.1 + version: 9.10.2 - name: Upload artifact uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-linux-unknown-9101 - path: out-x86_64-linux-unknown-9.10.1.tar + name: artifacts-build-x86_64-linux-unknown-9102 + path: out-x86_64-linux-unknown-9.10.2.tar retention-days: 2 build-x86_64-linux-unknown-9122: env: @@ -3182,36 +2851,6 @@ jobs: name: artifacts-build-x86_64-linux-unknown-9122 path: out-x86_64-linux-unknown-9.12.2.tar retention-days: 2 - build-x86_64-linux-unknown-948: - env: - ADD_CABAL_ARGS: --enable-split-sections - ARCH: '64' - ARTIFACT: x86_64-linux-unknown - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - DEBIAN_FRONTEND: noninteractive - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-linux-unknown-948 (Build binaries) - runs-on: - - ubuntu-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - name: Build 9.4.8 - uses: ./.github/actions/bindist-actions/action-unknown - with: - stage: BUILD - version: 9.4.8 - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-linux-unknown-948 - path: out-x86_64-linux-unknown-9.4.8.tar - retention-days: 2 build-x86_64-linux-unknown-967: env: ADD_CABAL_ARGS: --enable-split-sections @@ -3272,7 +2911,7 @@ jobs: name: artifacts-build-x86_64-linux-unknown-984 path: out-x86_64-linux-unknown-9.8.4.tar retention-days: 2 - build-x86_64-mac-9101: + build-x86_64-mac-9102: env: ADD_CABAL_ARGS: '' ARCH: '64' @@ -3284,14 +2923,14 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: build-x86_64-mac-9101 (Build binaries) + name: build-x86_64-mac-9102 (Build binaries) runs-on: - macOS-13 steps: - name: Checkout uses: actions/checkout@v4 - env: - GHC_VERSION: 9.10.1 + GHC_VERSION: 9.10.2 name: Run build run: | brew install coreutils tree @@ -3302,8 +2941,8 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-mac-9101 - path: out-x86_64-apple-darwin-9.10.1.tar + name: artifacts-build-x86_64-mac-9102 + path: out-x86_64-apple-darwin-9.10.2.tar retention-days: 2 build-x86_64-mac-9122: env: @@ -3338,39 +2977,6 @@ jobs: name: artifacts-build-x86_64-mac-9122 path: out-x86_64-apple-darwin-9.12.2.tar retention-days: 2 - build-x86_64-mac-948: - env: - ADD_CABAL_ARGS: '' - ARCH: '64' - ARTIFACT: x86_64-apple-darwin - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - MACOSX_DEPLOYMENT_TARGET: '10.13' - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: tar.xz - TZ: Asia/Singapore - environment: CI - name: build-x86_64-mac-948 (Build binaries) - runs-on: - - macOS-13 - steps: - - name: Checkout - uses: actions/checkout@v4 - - env: - GHC_VERSION: 9.4.8 - name: Run build - run: | - brew install coreutils tree - bash .github/scripts/build.sh - tar cf out-${ARTIFACT}-${GHC_VERSION}.tar out/ store/ - shell: sh - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-mac-948 - path: out-x86_64-apple-darwin-9.4.8.tar - retention-days: 2 build-x86_64-mac-967: env: ADD_CABAL_ARGS: '' @@ -3437,7 +3043,7 @@ jobs: name: artifacts-build-x86_64-mac-984 path: out-x86_64-apple-darwin-9.8.4.tar retention-days: 2 - build-x86_64-windows-9101: + build-x86_64-windows-9102: env: ADD_CABAL_ARGS: '' ARCH: '64' @@ -3448,14 +3054,14 @@ jobs: TARBALL_EXT: zip TZ: Asia/Singapore environment: CI - name: build-x86_64-windows-9101 (Build binaries) + name: build-x86_64-windows-9102 (Build binaries) runs-on: - windows-latest steps: - name: Checkout uses: actions/checkout@v4 - env: - GHC_VERSION: 9.10.1 + GHC_VERSION: 9.10.2 name: Run build run: | $env:CHERE_INVOKING = 1 @@ -3467,7 +3073,7 @@ jobs: uses: actions/upload-artifact@v4 with: if-no-files-found: error - name: artifacts-build-x86_64-windows-9101 + name: artifacts-build-x86_64-windows-9102 path: ./out/* retention-days: 2 build-x86_64-windows-9122: @@ -3503,39 +3109,6 @@ jobs: name: artifacts-build-x86_64-windows-9122 path: ./out/* retention-days: 2 - build-x86_64-windows-948: - env: - ADD_CABAL_ARGS: '' - ARCH: '64' - ARTIFACT: x86_64-mingw64 - AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} - AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} - S3_HOST: ${{ secrets.S3_HOST }} - TARBALL_EXT: zip - TZ: Asia/Singapore - environment: CI - name: build-x86_64-windows-948 (Build binaries) - runs-on: - - windows-latest - steps: - - name: Checkout - uses: actions/checkout@v4 - - env: - GHC_VERSION: 9.4.8 - name: Run build - run: | - $env:CHERE_INVOKING = 1 - $env:MSYS2_PATH_TYPE = "inherit" - $ErrorActionPreference = "Stop" - C:\msys64\usr\bin\bash -lc "bash .github/scripts/build.sh" - shell: pwsh - - name: Upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: artifacts-build-x86_64-windows-948 - path: ./out/* - retention-days: 2 build-x86_64-windows-967: env: ADD_CABAL_ARGS: '' @@ -3613,14 +3186,15 @@ jobs: - test-x86_64-linux-deb9 - test-x86_64-linux-deb10 - test-x86_64-linux-deb11 + - test-x86_64-linux-deb12 - test-x86_64-linux-ubuntu1804 - test-x86_64-linux-ubuntu2004 - test-x86_64-linux-ubuntu2204 - test-x86_64-linux-mint193 - test-x86_64-linux-mint202 - - test-x86_64-linux-fedora27 + - test-x86_64-linux-mint213 - test-x86_64-linux-fedora33 - - test-x86_64-linux-centos7 + - test-x86_64-linux-fedora40 - test-x86_64-linux-unknown runs-on: ubuntu-latest steps: @@ -3661,6 +3235,11 @@ jobs: with: name: bindist-x86_64-linux-deb11 path: ./out + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: bindist-x86_64-linux-deb12 + path: ./out - name: Download artifacts uses: actions/download-artifact@v4 with: @@ -3689,7 +3268,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-fedora27 + name: bindist-x86_64-linux-mint213 path: ./out - name: Download artifacts uses: actions/download-artifact@v4 @@ -3699,7 +3278,7 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-centos7 + name: bindist-x86_64-linux-fedora40 path: ./out - name: Download artifacts uses: actions/download-artifact@v4 @@ -3801,11 +3380,11 @@ jobs: export RANLIB="$HOME/.brew/opt/llvm@13/bin/llvm-ranlib" bash .github/scripts/test.sh shell: sh - test-x86_64-linux-centos7: + test-x86_64-linux-deb10: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-centos7 + ARTIFACT: x86_64-linux-deb10 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -3813,9 +3392,9 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: test-x86_64-linux-centos7 (Test binaries) + name: test-x86_64-linux-deb10 (Test binaries) needs: - - bindist-x86_64-linux-centos7 + - bindist-x86_64-linux-deb10 runs-on: - ubuntu-latest steps: @@ -3824,17 +3403,17 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-centos7 + name: bindist-x86_64-linux-deb10 path: ./out - name: Test - uses: ./.github/actions/bindist-actions/action-centos7 + uses: ./.github/actions/bindist-actions/action-deb10 with: stage: TEST - test-x86_64-linux-deb10: + test-x86_64-linux-deb11: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb10 + ARTIFACT: x86_64-linux-deb11 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -3842,9 +3421,9 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: test-x86_64-linux-deb10 (Test binaries) + name: test-x86_64-linux-deb11 (Test binaries) needs: - - bindist-x86_64-linux-deb10 + - bindist-x86_64-linux-deb11 runs-on: - ubuntu-latest steps: @@ -3853,17 +3432,17 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-deb10 + name: bindist-x86_64-linux-deb11 path: ./out - name: Test - uses: ./.github/actions/bindist-actions/action-deb10 + uses: ./.github/actions/bindist-actions/action-deb11 with: stage: TEST - test-x86_64-linux-deb11: + test-x86_64-linux-deb12: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-deb11 + ARTIFACT: x86_64-linux-deb12 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -3871,9 +3450,9 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: test-x86_64-linux-deb11 (Test binaries) + name: test-x86_64-linux-deb12 (Test binaries) needs: - - bindist-x86_64-linux-deb11 + - bindist-x86_64-linux-deb12 runs-on: - ubuntu-latest steps: @@ -3882,10 +3461,10 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-deb11 + name: bindist-x86_64-linux-deb12 path: ./out - name: Test - uses: ./.github/actions/bindist-actions/action-deb11 + uses: ./.github/actions/bindist-actions/action-deb12 with: stage: TEST test-x86_64-linux-deb9: @@ -3917,11 +3496,11 @@ jobs: uses: ./.github/actions/bindist-actions/action-deb9 with: stage: TEST - test-x86_64-linux-fedora27: + test-x86_64-linux-fedora33: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora27 + ARTIFACT: x86_64-linux-fedora33 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -3929,9 +3508,9 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: test-x86_64-linux-fedora27 (Test binaries) + name: test-x86_64-linux-fedora33 (Test binaries) needs: - - bindist-x86_64-linux-fedora27 + - bindist-x86_64-linux-fedora33 runs-on: - ubuntu-latest steps: @@ -3940,17 +3519,17 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-fedora27 + name: bindist-x86_64-linux-fedora33 path: ./out - name: Test - uses: ./.github/actions/bindist-actions/action-fedora27 + uses: ./.github/actions/bindist-actions/action-fedora33 with: stage: TEST - test-x86_64-linux-fedora33: + test-x86_64-linux-fedora40: env: ADD_CABAL_ARGS: --enable-split-sections ARCH: '64' - ARTIFACT: x86_64-linux-fedora33 + ARTIFACT: x86_64-linux-fedora40 AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} DEBIAN_FRONTEND: noninteractive @@ -3958,9 +3537,9 @@ jobs: TARBALL_EXT: tar.xz TZ: Asia/Singapore environment: CI - name: test-x86_64-linux-fedora33 (Test binaries) + name: test-x86_64-linux-fedora40 (Test binaries) needs: - - bindist-x86_64-linux-fedora33 + - bindist-x86_64-linux-fedora40 runs-on: - ubuntu-latest steps: @@ -3969,10 +3548,10 @@ jobs: - name: Download artifacts uses: actions/download-artifact@v4 with: - name: bindist-x86_64-linux-fedora33 + name: bindist-x86_64-linux-fedora40 path: ./out - name: Test - uses: ./.github/actions/bindist-actions/action-fedora33 + uses: ./.github/actions/bindist-actions/action-fedora40 with: stage: TEST test-x86_64-linux-mint193: @@ -4033,6 +3612,35 @@ jobs: uses: ./.github/actions/bindist-actions/action-mint202 with: stage: TEST + test-x86_64-linux-mint213: + env: + ADD_CABAL_ARGS: --enable-split-sections + ARCH: '64' + ARTIFACT: x86_64-linux-mint213 + AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} + DEBIAN_FRONTEND: noninteractive + S3_HOST: ${{ secrets.S3_HOST }} + TARBALL_EXT: tar.xz + TZ: Asia/Singapore + environment: CI + name: test-x86_64-linux-mint213 (Test binaries) + needs: + - bindist-x86_64-linux-mint213 + runs-on: + - ubuntu-latest + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Download artifacts + uses: actions/download-artifact@v4 + with: + name: bindist-x86_64-linux-mint213 + path: ./out + - name: Test + uses: ./.github/actions/bindist-actions/action-mint213 + with: + stage: TEST test-x86_64-linux-ubuntu1804: env: ADD_CABAL_ARGS: --enable-split-sections diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index e46e627b7c..35a3bd4ac4 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -["9.12", "9.10", "9.8", "9.6", "9.4"] +["9.12", "9.10", "9.8", "9.6"] diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 71a9e85443..984758a310 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -255,6 +255,12 @@ jobs: name: Test hls-notes-plugin test suite run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests + # The plugin tutorial is only compatible with 9.6 and 9.8. + # No particular reason, just to avoid excessive CPP. + - if: matrix.test && matrix.ghc != '9.4' && matrix.ghc != '9.10' && matrix.ghc != '9.12' + name: Compile the plugin-tutorial + run: cabal build plugin-tutorial + test_post_job: if: always() runs-on: ubuntu-latest diff --git a/CODEOWNERS b/CODEOWNERS index 7d66f7805e..820661ceeb 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -4,7 +4,6 @@ /hls-graph @wz1000 /hls-plugin-api @michaelpj @fendor /hls-test-utils @fendor -/hie-compat @wz1000 # HLS main /src @fendor diff --git a/ChangeLog.md b/ChangeLog.md index 3c8441f26d..65000395e2 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,74 @@ # Changelog for haskell-language-server + +## 2.11.0.0 + +- Bindists for GHC 9.12.2 + - Full plugin support, inlcuding refactor plugin +- Bindists for GHC 9.10.2 +- Bindists for GHC 9.8.4 +- Bindists for GHC 9.6.7 +- Bindists for GHC 9.4.8 +- Dropped support for Centos 7 as this platform is no longer supported by ghc +- Improved import suggestions for contructors and OverloadedRecordDot fields + +### Pull Requests + +- Add doc for project-wide renaming + ([#4584](https://github.com/haskell/haskell-language-server/pull/4584)) by @jian-lin +- Use hie-bios 0.15.0 + ([#4582](https://github.com/haskell/haskell-language-server/pull/4582)) by @fendor +- Allow building HLS with GHC 9.10.2 + ([#4581](https://github.com/haskell/haskell-language-server/pull/4581)) by @fendor +- Fix Plugin support table for 9.12.2 + ([#4580](https://github.com/haskell/haskell-language-server/pull/4580)) by @fendor +- Fix misplaced inlay hints by applying PositionMapping + ([#4571](https://github.com/haskell/haskell-language-server/pull/4571)) by @jetjinser +- Enable hls-plugin-gadt for ghc-9.12 + ([#4568](https://github.com/haskell/haskell-language-server/pull/4568)) by @GuillaumedeVolpiano +- Remove no longer needed allow-newer + ([#4566](https://github.com/haskell/haskell-language-server/pull/4566)) by @jhrcek +- Add missing golden files for GHC 9.10 config tests + ([#4563](https://github.com/haskell/haskell-language-server/pull/4563)) by @jian-lin +- updating the plugins support table for refactor + ([#4560](https://github.com/haskell/haskell-language-server/pull/4560)) by @GuillaumedeVolpiano +- Enable stylish-haskell for ghc-9.10 and ghc-9.12 + ([#4559](https://github.com/haskell/haskell-language-server/pull/4559)) by @GuillaumedeVolpiano +- Bump haskell-actions/setup from 2.7.10 to 2.7.11 + ([#4557](https://github.com/haskell/haskell-language-server/pull/4557)) by @dependabot[bot] +- Provide code action in hls-eval-plugin + ([#4556](https://github.com/haskell/haskell-language-server/pull/4556)) by @jian-lin +- enable hlint for ghc-9.12 + ([#4555](https://github.com/haskell/haskell-language-server/pull/4555)) by @GuillaumedeVolpiano +- Enable fourmolu and ormolu for GHC 9.12 + ([#4554](https://github.com/haskell/haskell-language-server/pull/4554)) by @fendor +- Enable hls-cabal-gild-plugin for GHC 9.12.2 + ([#4553](https://github.com/haskell/haskell-language-server/pull/4553)) by @fendor +- Update plugin support table for GHC 9.12.2 + ([#4552](https://github.com/haskell/haskell-language-server/pull/4552)) by @fendor +- Remove allow-newer for hiedb + ([#4551](https://github.com/haskell/haskell-language-server/pull/4551)) by @jhrcek +- Fix typo of rename plugin config + ([#4546](https://github.com/haskell/haskell-language-server/pull/4546)) by @jian-lin +- Update the ghcup-metadata generation script + ([#4545](https://github.com/haskell/haskell-language-server/pull/4545)) by @fendor +- porting hls-refactor to ghc-9.12 + ([#4543](https://github.com/haskell/haskell-language-server/pull/4543)) by @GuillaumedeVolpiano +- add ghcide-bench flag to .cabal file + ([#4542](https://github.com/haskell/haskell-language-server/pull/4542)) by @juhp +- Revert "link executables dynamically to speed up linking (#4423)" + ([#4541](https://github.com/haskell/haskell-language-server/pull/4541)) by @fendor +- Support PackageImports in hiddenPackageSuggestion + ([#4537](https://github.com/haskell/haskell-language-server/pull/4537)) by @jian-lin +- Improve FreeBSD installation docs + ([#4536](https://github.com/haskell/haskell-language-server/pull/4536)) by @arrowd +- reinstating ignore-plugins-ghc-bounds + ([#4532](https://github.com/haskell/haskell-language-server/pull/4532)) by @GuillaumedeVolpiano +- Simplify FuzzySearch test (avoid dependency on /usr/share/dict/words) + ([#4531](https://github.com/haskell/haskell-language-server/pull/4531)) by @jhrcek +- Import suggestion for missing newtype constructor, all types constructor and indirect overloadedrecorddot fields + ([#4516](https://github.com/haskell/haskell-language-server/pull/4516)) by @guibou + ## 2.10.0.0 - Bindists for GHC 9.12.2 diff --git a/RELEASING.md b/RELEASING.md index a48b32cb93..74da125d86 100644 --- a/RELEASING.md +++ b/RELEASING.md @@ -9,7 +9,6 @@ - [ ] bump package versions in all `*.cabal` files (same version as hls) - HLS uses lockstep versioning. The core packages and all plugins use the same version number, and only support exactly this version. - Exceptions: - - `hie-compat` requires no automatic version bump. - `shake-bench` is an internal testing tool, not exposed to the outside world. Thus, no version bump required for releases. - For updating cabal files, the following script can be used: - ```sh diff --git a/cabal.project b/cabal.project index f79f33e7db..8d8bd080af 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,5 @@ packages: ./ - ./hie-compat ./shake-bench ./hls-graph ./ghcide @@ -8,7 +7,7 @@ packages: ./hls-test-utils -index-state: 2025-05-06T13:26:29Z +index-state: 2025-08-08T12:31:54Z tests: True test-show-details: direct diff --git a/docs/contributing/contributing.md b/docs/contributing/contributing.md index 134a03b89c..08ad21f12e 100644 --- a/docs/contributing/contributing.md +++ b/docs/contributing/contributing.md @@ -197,7 +197,6 @@ pre-commit install #### Why are some components excluded from automatic formatting? - `test/testdata` and `test/data` are excluded because we want to test formatting plugins. -- `hie-compat` is excluded because we want to keep its code as close to GHC as possible. ## Plugin tutorial diff --git a/docs/contributing/plugin-tutorial.lhs b/docs/contributing/plugin-tutorial.lhs new file mode 120000 index 0000000000..e1837100c2 --- /dev/null +++ b/docs/contributing/plugin-tutorial.lhs @@ -0,0 +1 @@ +plugin-tutorial.md \ No newline at end of file diff --git a/docs/contributing/plugin-tutorial.md b/docs/contributing/plugin-tutorial.md index c952ef9eb2..d9ca59c0ad 100644 --- a/docs/contributing/plugin-tutorial.md +++ b/docs/contributing/plugin-tutorial.md @@ -1,26 +1,113 @@ # Let’s write a Haskell Language Server plugin -Originally written by Pepe Iborra, maintained by the Haskell community. -Haskell Language Server (HLS) is an LSP server for the Haskell programming language. It builds on several previous efforts -to create a Haskell IDE. You can find many more details on the history and architecture in the [IDE 2020](https://mpickering.github.io/ide/index.html) community page. +Originally written by Pepe Iborra, maintained by the Haskell community. +Haskell Language Server (HLS) is a Language Server Protocol (LSP) server for the Haskell programming language. It builds on several previous efforts to create a Haskell IDE. +You can find many more details on the history and architecture on the [IDE 2020](https://mpickering.github.io/ide/index.html) community page. In this article we are going to cover the creation of an HLS plugin from scratch: a code lens to display explicit import lists. -Along the way we will learn about HLS, its plugin model, and the relationship with `ghcide` and LSP. +Along the way we will learn about HLS, its plugin model, and the relationship with [ghcide](https://github.com/haskell/haskell-language-server/tree/master/ghcide) and LSP. ## Introduction Writing plugins for HLS is a joy. Personally, I enjoy the ability to tap into the gigantic bag of goodies that is GHC, as well as the IDE integration thanks to LSP. -In the last couple of months I have written various HLS (and `ghcide`) plugins for things like: +In the last couple of months, I have written various HLS plugins, including: 1. Suggest imports for variables not in scope, 2. Remove redundant imports, -2. Evaluate code in comments (à la [doctest](https://docs.python.org/3/library/doctest.html)), -3. Integrate the [retrie](https://github.com/facebookincubator/retrie) refactoring library. +3. Evaluate code in comments (à la [doctest](https://docs.python.org/3/library/doctest.html)), +4. Integrate the [retrie](https://github.com/facebookincubator/retrie) refactoring library. + +These plugins are small but meaningful steps towards a more polished IDE experience. +While writing them, I didn't have to worry about performance, UI, or distribution; another tool (usually GHC) always did the heavy lifting. + +The plugins also make these tools much more accessible to all users of HLS. + +## Preamble + +This tutorial is a literate Haskell file that can be compiled. +As such, we list the imports, extensions etc... necessary for compilation. + +Please just skip over this `import` section, if you are only interested in the tutorial! + +```haskell +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} + +import Ide.Types +import Ide.Logger +import Ide.Plugin.Error + +import Development.IDE.Core.RuleTypes +import Development.IDE.Core.Service hiding (Log) +import Development.IDE.Core.Shake hiding (Log) +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Error +import Development.IDE.Types.HscEnvEq +import Development.IDE.Core.PluginUtils + +import qualified Language.LSP.Server as LSP +import Language.LSP.Protocol.Types as JL +import Language.LSP.Protocol.Message + +import Data.Aeson as Aeson +import Data.Map (Map) +import Data.IORef +import Data.Maybe (fromMaybe, catMaybes) +import qualified Data.Map as Map +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text as T +import Control.Monad (forM) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class +import GHC.Generics (Generic) +``` -These plugins are small but meaningful steps towards a more polished IDE experience, and in writing them I didn't have to worry about performance, UI, distribution, or even think for the most part, since it's always another tool (usually GHC) doing all the heavy lifting. The plugins also make these tools much more accessible to all users of HLS. +## Plugins in the HLS codebase -## The task +The HLS codebase includes several plugins (found in `./plugins`). For example: + +- The `ormolu`, `fourmolu`, `floskell` and `stylish-haskell` plugins used to format code +- The `eval` plugin, a code lens provider to evaluate code in comments +- The `retrie` plugin, a code action provider to execute retrie commands + +I recommend looking at the existing plugins for inspiration and reference. A few conventions shared by all plugins are: + +- Plugins are in the `./plugins` folder +- Plugins implement their code under the `Ide.Plugin.*` namespace +- Folders containing the plugin follow the `hls-pluginname-plugin` naming convention +- Plugins are "linked" in `src/HlsPlugins.hs#idePlugins`. New plugin descriptors + must be added there. + + ```haskell ignore + -- Defined in src/HlsPlugins.**hs** + + idePlugins = pluginDescToIdePlugins allPlugins + where + allPlugins = + [ GhcIde.descriptor "ghcide" + , Pragmas.descriptor "pragmas" + , Floskell.descriptor "floskell" + , Fourmolu.descriptor "fourmolu" + , Ormolu.descriptor "ormolu" + , StylishHaskell.descriptor "stylish-haskell" + , Retrie.descriptor "retrie" + , Eval.descriptor "eval" + , NewPlugin.descriptor "new-plugin" -- Add new plugins here. + ] + ``` + +To add a new plugin, extend the list of `allPlugins` and rebuild. + +## The goal of the plugin we will write Here is a visual statement of what we want to accomplish: @@ -29,301 +116,226 @@ Here is a visual statement of what we want to accomplish: And here is the gist of the algorithm: 1. Request the type checking artifacts from the `ghcide` subsystem -2. Extract the actual import lists from the type-checked AST, -3. Ask GHC to produce the minimal import lists for this AST, -4. For every import statement without an explicit import list, find out the minimal import list, and produce a code lens to display it together with a command to graft it on. +2. Extract the actual import lists from the type-checked AST +3. Ask GHC to produce the minimal import lists for this AST +4. For every import statement without an explicit import list: + - Determine the minimal import list + - Produce a code lens to display it and a command to apply it ## Setup -To get started, let’s fetch the HLS repository and build it. You need at least GHC 9.0 for this: +To get started, fetch the HLS repository and build it by following the [installation instructions](https://haskell-language-server.readthedocs.io/en/latest/contributing/contributing.html#building). -``` -git clone --recursive http://github.com/haskell/haskell-language-server hls -cd hls -cabal update -cabal build -``` +If you run into any issues trying to build the binaries, you can get in touch with the HLS team using one of the [contact channels](https://haskell-language-server.readthedocs.io/en/latest/contributing/contributing.html#how-to-contact-the-haskell-ide-team) or [open an issue](https://github.com/haskell/haskell-language-server/issues) in the HLS repository. -If you run into any issues trying to build the binaries, the `#haskell-language-server` IRC chat room in -[Libera Chat](https://libera.chat/) is always a good place to ask for help. +Once the build is done, you can find the location of the HLS binary with `cabal list-bin exe:haskell-language-server` and point your LSP client to it. +This way you can simply test your changes by reloading your editor after rebuilding the binary. -Once cabal is done take a note of the location of the `haskell-language-server` binary and point your LSP client to it. In VSCode this is done by editing the "Haskell Server Executable Path" setting. This way you can simply test your changes by reloading your editor after rebuilding the binary. +> **Note:** In VSCode, edit the "Haskell Server Executable Path" setting. +> +> **Note:** In Emacs, edit the `lsp-haskell-server-path` variable. ![Settings](settings-vscode.png) -## Anatomy of a plugin - -HLS plugins are values of the `Plugin` datatype, which is defined in `Ide.Plugin` as: -```haskell -data PluginDescriptor = - PluginDescriptor { pluginId :: !PluginId - , pluginRules :: !(Rules ()) - , pluginCommands :: ![PluginCommand] - , pluginCodeActionProvider :: !(Maybe CodeActionProvider) - , pluginCodeLensProvider :: !(Maybe CodeLensProvider) - , pluginHoverProvider :: !(Maybe HoverProvider) - , pluginSymbolsProvider :: !(Maybe SymbolsProvider) - , pluginFormattingProvider :: !(Maybe (FormattingProvider IO)) - , pluginCompletionProvider :: !(Maybe CompletionProvider) - , pluginRenameProvider :: !(Maybe RenameProvider) - } -``` -A plugin has a unique ID, a set of rules, a set of command handlers, and a set of "providers": +[Manually test your hacked HLS](https://haskell-language-server.readthedocs.io/en/latest/contributing/contributing.html#manually-testing-your-hacked-hls) to ensure you use the HLS package you just built. -* Rules add new targets to the Shake build graph defined in `ghcide`. 99% of plugins need not define any new rules. -* Commands are an LSP abstraction for actions initiated by the user which are handled in the server. These actions can be long running and involve multiple modules. Many plugins define command handlers. -* Providers are a query-like abstraction where the LSP client asks the server for information. These queries must be fulfilled as quickly as possible. +## Digression about the Language Server Protocol -The HLS codebase includes several plugins under the namespace `Ide.Plugin.*`, the most relevant are: +There are two main types of communication in the Language Server Protocol: -- The `ghcide` plugin, which embeds `ghcide` as a plugin (`ghcide` is also the engine under HLS), -- The `ormolu`, `fourmolu`, `floskell` and `stylish-haskell` plugins, a testament to the code formatting wars of our community, -- The `eval` plugin, a code lens provider to evaluate code in comments, -- The `retrie` plugin, a code actions provider to execute retrie commands. +- A **request-response interaction** type where one party sends a message that requires a response from the other party. +- A **notification** is a one-way interaction where one party sends a message without expecting any response. -I would recommend looking at the existing plugins for inspiration and reference. +> **Note**: The LSP client and server can both send requests or notifications to the other party. -Plugins are "linked" in the `HlsPlugins` module, so we will need to add our plugin there once we have defined it: - -```haskell -idePlugins = pluginDescToIdePlugins allPlugins - where - allPlugins = - [ GhcIde.descriptor "ghcide" - , Pragmas.descriptor "pragmas" - , Floskell.descriptor "floskell" - , Fourmolu.descriptor "fourmolu" - , Ormolu.descriptor "ormolu" - , StylishHaskell.descriptor "stylish-haskell" - , Retrie.descriptor "retrie" - , Eval.descriptor "eval" - ] -``` -To add a new plugin, simply extend the list of `allPlugins` and rebuild. +## Anatomy of a plugin -## Providers +HLS plugins are values of the `PluginDescriptor` datatype, which is defined in `hls-plugin-api/src/Ide/Types.hs` as: -99% of plugins will want to define at least one type of provider. But what is a provider? Let's take a look at some types: -```haskell -type CodeActionProvider = LSP.LspFuncs Config - -> IdeState - -> PluginId - -> TextDocumentIdentifier - -> Range - -> CodeActionContext - -> IO (Either ResponseError (List CAResult)) - -type CompletionProvider = LSP.LspFuncs Config - -> IdeState - -> CompletionParams - -> IO (Either ResponseError CompletionResponseResult) - -type CodeLensProvider = LSP.LspFuncs Config - -> IdeState - -> PluginId - -> CodeLensParams - -> IO (Either ResponseError (List CodeLens)) - -type RenameProvider = LSP.LspFuncs Config - -> IdeState - -> RenameParams - -> IO (Either ResponseError WorkspaceEdit) +```haskell ignore +data PluginDescriptor (ideState :: Type) = + PluginDescriptor { pluginId :: !PluginId + , pluginCommands :: ![PluginCommand ideState] + , pluginHandlers :: PluginHandlers ideState + , pluginNotificationHandlers :: PluginNotificationHandlers ideState +-- , [...] -- Other fields omitted for brevity. + } ``` -Providers are functions that receive some inputs and produce an IO computation that returns either an error or some result. +### Request-response interaction -All providers receive an `LSP.LspFuncs` value, which is a record of functions to perform LSP actions. Most providers can safely ignore this argument, since the LSP interaction is automatically managed by HLS. -Some of its capabilities are: -- Querying the LSP client capabilities, -- Manual progress reporting and cancellation, for plugins that provide long running commands (like the `retrie` plugin), -- Custom user interactions via [message dialogs](https://microsoft.github.io/language-server-protocol/specification#window_showMessage). For instance, the `retrie` plugin uses this to report skipped modules. +The `pluginHandlers` handle LSP client requests and provide responses to the client. They must fulfill these requests as quickly as possible. -The second argument, which plugins receive, is `IdeState`. `IdeState` encapsulates all the `ghcide` state including the build graph. This allows to request `ghcide` rule results, which leverages Shake to parallelize and reuse previous results as appropriate. Rule types are instances of the `RuleResult` type family, and -most of them are defined in `Development.IDE.Core.RuleTypes`. Some relevant rule types are: -```haskell --- | The parse tree for the file using GetFileContents -type instance RuleResult GetParsedModule = ParsedModule +- Example: When you want to format a file, the client sends the [`textDocument/formatting`](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_formatting) request to the server. The server formats the file and responds with the formatted content. --- | The type checked version of this file -type instance RuleResult TypeCheck = TcModuleResult +### Notification --- | A GHC session that we reuse. -type instance RuleResult GhcSession = HscEnvEq +The `pluginNotificationHandlers` handle notifications sent by the client to the server that are not explicitly triggered by a user. --- | A GHC session preloaded with all the dependencies -type instance RuleResult GhcSessionDeps = HscEnvEq +- Example: Whenever you modify a Haskell file, the client sends a notification informing HLS about the changes to the file. --- | A ModSummary that has enough information to be used to get .hi and .hie files. -type instance RuleResult GetModSummary = ModSummary -``` +The `pluginCommands` are special types of user-initiated notifications sent to +the server. These actions can be long-running and involve multiple modules. -The `use` family of combinators allows to request rule results. For example, the following code is used in the `eval` plugin to request a GHC session and a module summary (for the imports) in order to set up an interactive evaluation environment -```haskell - let nfp = toNormalizedFilePath' fp - session <- runAction "runEvalCmd.ghcSession" state $ use_ GhcSessionDeps nfp - ms <- runAction "runEvalCmd.getModSummary" state $ use_ GetModSummary nfp -``` +## The explicit imports plugin -There are three flavours of `use` combinators: +To achieve our plugin goals, we need to define: -1. `use*` combinators block and propagate errors, -2. `useWithStale*` combinators block and switch to stale data in case of an error, -3. `useWithStaleFast*` combinators return immediately with stale data if any, or block otherwise. +- a command handler (`importLensCommand`), +- a code lens request handler (`lensProvider`). -## LSP abstractions +These will be assembled in the `descriptor` function of the plugin, which contains all the information wrapped in the `PluginDescriptor` datatype mentioned above. -If you have used VSCode or any other LSP editor you are probably already familiar with the capabilities afforded by LSP. If not, check the [specification](https://microsoft.github.io/language-server-protocol/specification) for the full details. -Another good source of information is the [haskell-lsp-types](https://hackage.haskell.org/package/haskell-lsp-types) package, which contains a Haskell encoding of the protocol. +Using the convenience `defaultPluginDescriptor` function, we can bootstrap the plugin with the required parts: -The [haskell-lsp-types](https://hackage.haskell.org/package/haskell-lsp-types-0.22.0.0/docs/Language-Haskell-LSP-Types.html#t:CodeLens) package encodes code lenses in Haskell as: ```haskell -data CodeLens = - CodeLens - { _range :: Range - , _command :: Maybe Command - , _xdata :: Maybe A.Value - } deriving (Read,Show,Eq) -``` -That is, a code lens is a triple of a source range, maybe a command, and optionally some extra data. The [specification](https://microsoft.github.io/language-server-protocol/specification#textDocument_codeLens) clarifies the optionality: -``` -/** - * A code lens represents a command that should be shown along with - * source text, like the number of references, a way to run tests, etc. - * - * A code lens is _unresolved_ when no command is associated to it. For performance - * reasons the creation of a code lens and resolving should be done in two stages. - */ +-- plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs + +data Log + +-- | The "main" function of a plugin. +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = + (defaultPluginDescriptor plId "A plugin for generating the minimal imports") + { pluginCommands = [importLensCommand], -- The plugin provides a command handler + pluginHandlers = mconcat -- The plugin provides request handlers + [ mkPluginHandler SMethod_TextDocumentCodeLens provider + ] + } ``` -To keep things simple our plugin won't make use of the unresolved facility, embedding the command directly in the code lens. +We'll start with the command, since it's the simplest of the two. -## The explicit imports plugin +### The command handler -To provide code lenses, our plugin must define a code lens provider as well as a command handler. -The code at `Ide.Plugin.Example` shows how the convenience `defaultPluginDescriptor` function is used -to bootstrap the plugin and how to add the desired providers: +In short, LSP commands work like this: -```haskell -descriptor :: PluginId -> PluginDescriptor -descriptor plId = (defaultPluginDescriptor plId) { - -- This plugin provides code lenses - pluginCodeLensProvider = Just provider, - -- This plugin provides a command handler - pluginCommands = [ importLensCommand ] -} -``` - -### The command handler +- The LSP server (HLS) initially sends a command descriptor to the client, in this case as part of a code lens. +- When the user clicks on the code lens, the client asks HLS to execute the command with the given descriptor. The server then handles and executes the command; this latter part is implemented by the `commandFunc` field of our `PluginCommand` value. -Our plugin provider has two components that need to be fleshed out. Let's start with the command provider, since it's the simplest of the two. +> **Note**: Check the [LSP spec](https://microsoft.github.io/language-server-protocol/specification) for a deeper understanding of how commands work. -```haskell -importLensCommand :: PluginCommand -``` +The command handler will be called `importLensCommand` and have the `PluginCommand` type, a type defined in `Ide.Types` as: -`PluginCommand` is a data type defined in `LSP.Types` as: +```haskell ignore +-- hls-plugin-api/src/Ide/Types.hs -```haskell -data PluginCommand = forall a. (FromJSON a) => +data PluginCommand ideState = forall a. (FromJSON a) => PluginCommand { commandId :: CommandId , commandDesc :: T.Text - , commandFunc :: CommandFunction a + , commandFunc :: CommandFunction ideState a } ``` -The meat is in the `commandFunc` field, which is of type `CommandFunction`, another type synonym from `LSP.Types`: -```haskell -type CommandFunction a = - LSP.LspFuncs Config - -> IdeState - -> a - -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams)) -``` - -`CommandFunction` takes in the familiar `LspFuncs` and `IdeState` arguments, together with a JSON encoded argument. -I recommend checking the LSP specifications in order to understand how commands work, but briefly the LSP server (us) initially sends a command descriptor to the client, in this case as part of a code lens. When the client decides to execute the command on behalf of a user action (in this case a click on the code lens), the client sends this descriptor back to the LSP server which then proceeds to handle and execute the command. The latter part is implemented by the `commandFunc` field of our `PluginCommand` value. +Let's start by creating an unfinished command handler. We'll give it an ID and a description for now: -For our command, we are going to have a very simple handler that receives a diff (`WorkspaceEdit`) and returns it to the client. The diff will be generated by our code lens provider and sent as part -of the code lens to the LSP client, who will send it back to our command handler when the user activates -the code lens: ```haskell +-- | The command handler. +importLensCommand :: PluginCommand IdeState +importLensCommand = + PluginCommand + { commandId = importCommandId + , commandDesc = "Explicit import command" + , commandFunc = runImportCommand + } + importCommandId :: CommandId importCommandId = "ImportLensCommand" +``` -importLensCommand :: PluginCommand -importLensCommand = - PluginCommand importCommandId "Explicit import command" runImportCommand +```haskell ignore +-- | Not implemented yet. +runImportCommand = undefined +``` + +The most important (and still `undefined`) field is `commandFunc :: CommandFunction`, a type synonym from `LSP.Types`: + +```haskell ignore +-- hls-plugin-api/src/Ide/Types.hs +type CommandFunction ideState a + = ideState + -> a + -> LspM Config (Either ResponseError Value) +``` + +`CommandFunction` takes an `ideState` and a JSON-encodable argument. `LspM` is a monad transformer with access to IO, and having access to a language context environment `Config`. The action evaluates to an `Either` value. `Left` indicates failure with a `ResponseError`, `Right` indicates sucess with a `Value`. + +Our handler will ignore the state argument and only use the `WorkspaceEdit` argument. + +```haskell -- | The type of the parameters accepted by our command -data ImportCommandParams = ImportCommandParams WorkspaceEdit - deriving Generic +newtype ImportCommandParams = ImportCommandParams WorkspaceEdit + deriving (Generic) deriving anyclass (FromJSON, ToJSON) -- | The actual command handler -runImportCommand :: CommandFunction ImportCommandParams -runImportCommand _lspFuncs _state (ImportCommandParams edit) = do - return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edit)) - +runImportCommand :: CommandFunction IdeState ImportCommandParams +runImportCommand _ _ (ImportCommandParams edit) = do + -- This command simply triggers a workspace edit! + _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) + return $ InR JL.Null ``` +`runImportCommand` [sends a request](https://hackage.haskell.org/package/lsp/docs/Language-LSP-Server.html#v:sendRequest) to the client using the method `SWorkspaceApplyEdit` and the parameters `ApplyWorkspaceEditParams Nothing edit`, providing a response handler that does nothing. It then returns `Right Null`, which is an empty `Aeson.Value` wrapped in `Right`. + ### The code lens provider The code lens provider implements all the steps of the algorithm described earlier: -> 1. Request the type checking artefacts from the `ghcide` subsystem -> 2. Extract the actual import lists from the type-checked AST, -> 3. Ask GHC to produce the minimal import lists for this AST, -> 4. For every import statement without an explicit import list, find out the minimal import list, and produce a code lens to display it together with a command to graft it on. +> 1. Request the type checking artifacts. +> 2. Extract the actual import lists from the type-checked AST. +> 3. Ask GHC to produce the minimal import lists for this AST. +> 4. For each import statement lacking an explicit list, determine its minimal import list and generate a code lens displaying this list along with a command to insert it. -The provider takes the usual `LspFuncs` and `IdeState` argument, as well as a `CodeLensParams` value containing the URI -for a file, and returns an IO action producing either an error or a list of code lenses for that file. +The provider takes the usual `LspFuncs` and `IdeState` arguments, as well as a `CodeLensParams` value containing a file URI. It returns an IO action that produces either an error or a list of code lenses for that file. ```haskell -provider :: CodeLensProvider -provider _lspFuncs -- LSP functions, not used - state -- ghcide state, used to retrieve typechecking artifacts +provider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens +provider state -- ghcide state, used to retrieve typechecking artifacts pId -- Plugin ID - CodeLensParams{_textDocument = TextDocumentIdentifier{_uri}} + CodeLensParams{_textDocument = TextDocumentIdentifier{_uri}} = do -- VSCode uses URIs instead of file paths -- haskell-lsp provides conversion functions - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri - = do - -- Get the typechecking artifacts from the module - tmr <- runAction "importLens" state $ use TypeCheck nfp - -- We also need a GHC session with all the dependencies - hsc <- runAction "importLens" state $ use GhcSessionDeps nfp - -- Use the GHC API to extract the "minimal" imports - (imports, mbMinImports) <- extractMinimalImports hsc tmr - - case mbMinImports of - Just minImports -> do - let minImportsMap = - Map.fromList [ (srcSpanStart l, i) | L l i <- minImports ] - lenses <- forM imports $ - -- for every import, maybe generate a code lens - generateLens pId _uri minImportsMap - return $ Right (List $ catMaybes lenses) - _ -> - return $ Right (List []) - | otherwise - = return $ Right (List []) + nfp <- getNormalizedFilePathE _uri + -- Get the typechecking artifacts from the module + tmr <- runActionE "importLens" state $ useE TypeCheck nfp + -- We also need a GHC session with all the dependencies + hsc <- runActionE "importLens" state $ useE GhcSessionDeps nfp + -- Use the GHC API to extract the "minimal" imports + (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr + + case mbMinImports of + Just minImports -> do + let minImportsMap = + Map.fromList [ (realSrcLocToPosition loc, i) + | L l i <- minImports + , let RealSrcLoc loc _ = srcSpanStart (locA l) + ] + lenses <- forM imports $ \imp -> + -- for every import, maybe generate a code lens + liftIO (generateLens pId _uri minImportsMap imp) + return $ InL (catMaybes lenses) + _ -> + return $ InL [] ``` -Note how simple it is to retrieve the type checking artifacts for the module as well as a fully setup GHC session via the `ghcide` rules. +Note the simplicity of retrieving the type checking artifacts for the module, as well as a fully set up GHC session, via the `ghcide` rules. The function `extractMinimalImports` extracts the import statements from the AST and generates the minimal import lists, implementing steps 2 and 3 of the algorithm. + The details of the GHC API are not relevant to this tutorial, but the code is terse and easy to read: ```haskell extractMinimalImports - :: Maybe HscEnvEq - -> Maybe TcModuleResult + :: HscEnvEq + -> TcModuleResult -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn]) -extractMinimalImports (Just hsc)) (Just (tmrModule -> TypecheckedModule{..})) = do +extractMinimalImports hsc TcModuleResult{..} = do -- Extract the original imports and the typechecking environment - let (tcEnv,_) = tm_internals_ - Just (_, imports, _, _) = tm_renamed_source - ParsedModule{ pm_parsed_source = L loc _} = tm_parsed_module + let tcEnv = tmrTypechecked + (_, imports, _, _) = tmrRenamed + ParsedModule{ pm_parsed_source = L loc _} = tmrParsed span = fromMaybe (error "expected real") $ realSpan loc -- GHC is secretly full of mutable state @@ -334,44 +346,44 @@ extractMinimalImports (Just hsc)) (Just (tmrModule -> TypecheckedModule{..})) = -- getMinimalImports computes the minimal explicit import lists initTcWithGbl (hscEnv hsc) tcEnv span $ getMinimalImports usage return (imports, minimalImports) -extractMinimalImports _ _ = return ([], Nothing) ``` -The function `generateLens` implements step 4 of the algorithm, producing a code lens for an import statement that lacks an import list. Note how the code lens includes an `ImportCommandParams` value -that contains a workspace edit that rewrites the import statement, as expected by our command provider. +The function `generateLens` implements step 4 of the algorithm, producing a code lens for an import statement that lacks an import list. The code lens includes an `ImportCommandParams` value containing a workspace edit that rewrites the import statement, as our command provider expects. ```haskell -- | Given an import declaration, generate a code lens unless it has an explicit import list generateLens :: PluginId -> Uri - -> Map SrcLoc (ImportDecl GhcRn) + -> Map Position (ImportDecl GhcRn) -> LImportDecl GhcRn -> IO (Maybe CodeLens) generateLens pId uri minImports (L src imp) -- Explicit import list case - | ImportDecl{ideclHiding = Just (False,_)} <- imp + | ImportDecl{ideclImportList = Just _} <- imp = return Nothing -- No explicit import list - | RealSrcSpan l <- src - , Just explicit <- Map.lookup (srcSpanStart src) minImports + | RealSrcSpan l _ <- locA src + , let position = realSrcLocToPosition $ realSrcSpanStart l + , Just explicit <- Map.lookup position minImports , L _ mn <- ideclName imp -- (Almost) no one wants to see an explicit import list for Prelude , mn /= moduleName pRELUDE = do -- The title of the command is just the minimal explicit import decl - let title = T.pack $ prettyPrint explicit + let title = T.pack $ printWithoutUniques explicit -- The range of the code lens is the span of the original import decl _range :: Range = realSrcSpanToRange l -- The code lens has no extra data _xdata = Nothing -- An edit that replaces the whole declaration with the explicit one - edit = WorkspaceEdit (Just editsMap) Nothing - editsMap = HashMap.fromList [(uri, List [importEdit])] + edit = WorkspaceEdit (Just editsMap) Nothing Nothing + editsMap = Map.fromList [(uri, [importEdit])] importEdit = TextEdit _range title -- The command argument is simply the edit _arguments = Just [toJSON $ ImportCommandParams edit] - -- Create the command - _command <- Just <$> mkLspCommand pId importCommandId title _arguments + _data_ = Nothing + -- Create the command + _command = Just $ mkLspCommand pId importCommandId title _arguments -- Create and return the code lens return $ Just CodeLens{..} | otherwise @@ -381,14 +393,26 @@ generateLens pId uri minImports (L src imp) ## Wrapping up There's only one Haskell code change left to do at this point: "link" the plugin in the `HlsPlugins` HLS module. -However integrating the plugin in HLS itself will need some changes in configuration files. The best way is looking for the ID (f.e. `hls-class-plugin`) of an existing plugin: -- `./cabal*.project` and `./stack*.yaml`: add the plugin package in the `packages` field, -- `./haskell-language-server.cabal`: add a conditional block with the plugin package dependency, -- `./.github/workflows/test.yml`: add a block to run the test suite of the plugin, -- `./.github/workflows/hackage.yml`: add the plugin to the component list to release the plugin package to Hackage, -- `./*.nix`: add the plugin to Nix builds. -The full code as used in this tutorial, including imports, can be found in [this Gist](https://gist.github.com/pepeiborra/49b872b2e9ad112f61a3220cdb7db967) as well as in this [branch](https://github.com/pepeiborra/ide/blob/imports-lens/src/Ide/Plugin/ImportLens.hs) +Integrating the plugin into HLS itself requires changes to several configuration files. + +A good approach is to search for the ID of an existing plugin (e.g., `hls-class-plugin`): + +- `./haskell-language-server.cabal`: Add a conditional block with the plugin package dependency. +- `./.github/workflows/test.yml`: Add a block to run the plugin's test suite. +- `./.github/workflows/hackage.yml`: Add the plugin to the component list for releasing the plugin package to Hackage. +- `./*.nix`: Add the plugin to Nix builds. + +This plugin tutorial re-implements parts of the [`hls-explicit-imports-plugin`] which is part of HLS. +The plugin code additionally contains advanced concepts, such as `Rules`. -I hope this has given you a taste of how easy and joyful it is to write plugins for HLS. -If you are looking for ideas for contributing, here are some cool ones found in the HLS [issue tracker](https://github.com/haskell/haskell-language-server/issues?q=is%3Aopen+is%3Aissue+label%3A%22type%3A+possible+new+plugin%22). +I hope this has given you a taste of how easy and joyful it is to write plugins for HLS. If you are looking for contribution ideas, here are some good ones listed in the HLS [issue tracker](https://github.com/haskell/haskell-language-server/issues). + +
+ Placeholder Main, unused + +```haskell +main :: IO () +main = putStrLn "Just here to silence the error!" +``` +
diff --git a/docs/support/ghc-version-support.md b/docs/support/ghc-version-support.md index aa29c60c0a..df0bc23494 100644 --- a/docs/support/ghc-version-support.md +++ b/docs/support/ghc-version-support.md @@ -18,6 +18,7 @@ Support status (see the support policy below for more details): | GHC version | Last supporting HLS version | Support status | | ------------ | ------------------------------------------------------------------------------------ | -------------- | | 9.12.2 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support | +| 9.10.2 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support | | 9.10.1 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support | | 9.8.4 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support | | 9.8.2 | [2.9.0.1](https://github.com/haskell/haskell-language-server/releases/tag/2.9.0.1) | deprecated | diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index 7e0d7220e8..4263f0d035 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -55,7 +55,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-explicit-record-fields-plugin` | 2 | | | `hls-fourmolu-plugin` | 2 | | | `hls-gadt-plugin` | 2 | | -| `hls-hlint-plugin` | 2 | 9.10.1 | +| `hls-hlint-plugin` | 2 | | | `hls-module-name-plugin` | 2 | | | `hls-notes-plugin` | 2 | | | `hls-qualify-imported-names-plugin` | 2 | | diff --git a/docutils.nix b/docutils.nix deleted file mode 100644 index 1c47e1455d..0000000000 --- a/docutils.nix +++ /dev/null @@ -1,32 +0,0 @@ -{ stdenv, lib, fetchPypi, buildPythonPackage, isPy3k, python }: - -buildPythonPackage rec { - pname = "docutils"; - version = "0.17.1"; - - src = fetchPypi { - inherit pname version; - sha256 = "686577d2e4c32380bb50cbb22f575ed742d58168cee37e99117a854bcd88f125"; - }; - - # Only Darwin needs LANG, but we could set it in general. - # It's done here conditionally to prevent mass-rebuilds. - checkPhase = lib.optionalString (isPy3k && stdenv.isDarwin) - ''LANG="en_US.UTF-8" LC_ALL="en_US.UTF-8" '' + '' - ${python.interpreter} test/alltests.py - ''; - - # Create symlinks lacking a ".py" suffix, many programs depend on these names - postFixup = '' - for f in $out/bin/*.py; do - ln -s $(basename $f) $out/bin/$(basename $f .py) - done - ''; - - meta = with lib; { - description = "Python Documentation Utilities"; - homepage = "http://docutils.sourceforge.net/"; - license = with licenses; [ publicDomain bsd2 psfl gpl3Plus ]; - maintainers = with maintainers; [ AndersonTorres ]; - }; -} diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 2c2401ab6a..2fd885ffb3 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -38,7 +38,8 @@ import Control.Monad.Trans.Except (ExceptT, runExceptT, import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T -import Development.IDE.LSP.LanguageServer (runLanguageServer) +import Development.IDE.LSP.LanguageServer (Setup (..), + runLanguageServer) import qualified Development.IDE.Main as Main import Ide.Logger (Doc, Pretty (pretty), Recorder, WithPriority, @@ -300,7 +301,12 @@ launchErrorLSP recorder errorMsg = do [ exitHandler exit ] let interpretHandler (env, _st) = LSP.Iso (LSP.runLspT env . unErrorLSPM) liftIO - pure (doInitialize, asyncHandlers, interpretHandler) + pure MkSetup + { doInitialize + , staticHandlers = asyncHandlers + , interpretHandler + , onExit = [exit] + } runLanguageServer (cmapWithPrio pretty recorder) (Main.argsLspOptions defaultArguments) diff --git a/flake.lock b/flake.lock index 3fb48889a5..352483a773 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1733328505, - "narHash": "sha256-NeCCThCEP3eCl2l/+27kNNK7QrwZB1IJCrXfrbv5oqU=", + "lastModified": 1747046372, + "narHash": "sha256-CIVLLkVgvHYbgI2UpXvIIBJ12HWgX+fjA8Xf8PUmqCY=", "owner": "edolstra", "repo": "flake-compat", - "rev": "ff81ac966bb2cae68946d5ed5fc4994f96d0ffec", + "rev": "9100a0f413b0c601e0533d1d94ffd501ce2e7885", "type": "github" }, "original": { @@ -36,17 +36,17 @@ }, "nixpkgs": { "locked": { - "lastModified": 1739019272, - "narHash": "sha256-7Fu7oazPoYCbDzb9k8D/DdbKrC3aU1zlnc39Y8jy/s8=", + "lastModified": 1748437873, + "narHash": "sha256-E2640ouB7VxooUQdCiDRo/rVXnr1ykgF9A7HrwWZVSo=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "fa35a3c8e17a3de613240fea68f876e5b4896aec", + "rev": "c742ae7908a82c9bf23ce27bfca92a00e9bcd541", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", "repo": "nixpkgs", + "rev": "c742ae7908a82c9bf23ce27bfca92a00e9bcd541", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 934333cff0..1002eb87b5 100644 --- a/flake.nix +++ b/flake.nix @@ -2,7 +2,9 @@ description = "haskell-language-server development flake"; inputs = { - nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; + # Don't use nixpkgs-unstable as aarch64-darwin is currently broken there. + # Check again, when https://github.com/NixOS/nixpkgs/pull/414242 is resolved. + nixpkgs.url = "github:NixOS/nixpkgs/c742ae7908a82c9bf23ce27bfca92a00e9bcd541"; flake-utils.url = "github:numtide/flake-utils"; # For default.nix flake-compat = { @@ -13,7 +15,8 @@ outputs = { nixpkgs, flake-utils, ... }: - flake-utils.lib.eachSystem [ "x86_64-linux" "x86_64-darwin" "aarch64-linux" "aarch64-darwin" ] + flake-utils.lib.eachSystem + [ "x86_64-linux" "x86_64-darwin" "aarch64-linux" "aarch64-darwin" ] (system: let pkgs = import nixpkgs { @@ -21,11 +24,18 @@ config = { allowBroken = true; }; }; - pythonWithPackages = pkgs.python3.withPackages (ps: [ps.sphinx ps.myst-parser ps.sphinx_rtd_theme ps.pip]); + pythonWithPackages = pkgs.python3.withPackages (ps: + [ ps.docutils + ps.myst-parser + ps.pip + ps.sphinx + ps.sphinx_rtd_theme + ]); docs = pkgs.stdenv.mkDerivation { name = "hls-docs"; - src = pkgs.lib.sourceFilesBySuffices ./. [ ".py" ".rst" ".md" ".png" ".gif" ".svg" ".cabal" ]; + src = pkgs.lib.sourceFilesBySuffices ./. + [ ".py" ".rst" ".md" ".png" ".gif" ".svg" ".cabal" ]; buildInputs = [ pythonWithPackages ]; buildPhase = '' cd docs @@ -58,11 +68,14 @@ buildInputs = [ # Compiler toolchain hpkgs.ghc + hpkgs.haskell-language-server pkgs.haskellPackages.cabal-install # Dependencies needed to build some parts of Hackage gmp zlib ncurses + # for compatibility of curl with provided gcc + curl # Changelog tooling - (gen-hls-changelogs pkgs.haskellPackages) + (gen-hls-changelogs hpkgs) # For the documentation pythonWithPackages (pkgs.haskell.lib.justStaticExecutables (pkgs.haskell.lib.dontCheck pkgs.haskellPackages.opentelemetry-extra)) @@ -90,21 +103,17 @@ ''; }; - in rec { + in { # Developement shell with only dev tools devShells = { default = mkDevShell pkgs.haskellPackages; - shell-ghc94 = mkDevShell pkgs.haskell.packages.ghc94; shell-ghc96 = mkDevShell pkgs.haskell.packages.ghc96; shell-ghc98 = mkDevShell pkgs.haskell.packages.ghc98; shell-ghc910 = mkDevShell pkgs.haskell.packages.ghc910; + shell-ghc912 = mkDevShell pkgs.haskell.packages.ghc912; }; packages = { inherit docs; }; - - # The attributes for the default shell and package changed in recent versions of Nix, - # these are here for backwards compatibility with the old versions. - devShell = devShells.default; }); nixConfig = { diff --git a/ghcide-test/data/multi-unit/a-1.0.0-inplace b/ghcide-test/data/multi-unit/a-1.0.0-inplace index a54ea9bc4b..cab2b716ff 100644 --- a/ghcide-test/data/multi-unit/a-1.0.0-inplace +++ b/ghcide-test/data/multi-unit/a-1.0.0-inplace @@ -16,3 +16,6 @@ base text -XHaskell98 A ++RTS +-A32M +-RTS diff --git a/ghcide-test/data/multi-unit/c-1.0.0-inplace b/ghcide-test/data/multi-unit/c-1.0.0-inplace index 7201a40de4..7421d59279 100644 --- a/ghcide-test/data/multi-unit/c-1.0.0-inplace +++ b/ghcide-test/data/multi-unit/c-1.0.0-inplace @@ -17,3 +17,5 @@ a-1.0.0-inplace base -XHaskell98 C ++RTS +-A32M diff --git a/ghcide-test/data/references/Fields.hs b/ghcide-test/data/references/Fields.hs new file mode 100644 index 0000000000..1b935f31c9 --- /dev/null +++ b/ghcide-test/data/references/Fields.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RecordWildCards #-} +module Fields where + +data Foo = MkFoo + { + barr :: String, + bazz :: String + } + +fooUse0 :: Foo -> String +fooUse0 MkFoo{barr} = "5" + +fooUse1 :: Foo -> String +fooUse1 MkFoo{..} = "6" + +fooUse2 :: String -> String -> Foo +fooUse2 bar baz = + MkFoo{..} diff --git a/ghcide-test/data/references/Main.hs b/ghcide-test/data/references/Main.hs index 4a976f3fd0..aae14355d4 100644 --- a/ghcide-test/data/references/Main.hs +++ b/ghcide-test/data/references/Main.hs @@ -1,7 +1,7 @@ module Main where import References - +import Fields main :: IO () main = return () @@ -12,3 +12,6 @@ b = a + 1 acc :: Account acc = Savings + +fooUse3 :: String -> String -> Foo +fooUse3 bar baz = MkFoo{barr = bar, bazz = baz} diff --git a/ghcide-test/data/references/hie.yaml b/ghcide-test/data/references/hie.yaml index db42bad0c0..9e68765ba1 100644 --- a/ghcide-test/data/references/hie.yaml +++ b/ghcide-test/data/references/hie.yaml @@ -1 +1 @@ -cradle: {direct: {arguments: ["Main","OtherModule","OtherOtherModule","References"]}} +cradle: {direct: {arguments: ["Main","OtherModule","OtherOtherModule","References", "Fields"]}} diff --git a/ghcide-test/exe/CodeLensTests.hs b/ghcide-test/exe/CodeLensTests.hs index 4ec5f3957c..fd821e37b6 100644 --- a/ghcide-test/exe/CodeLensTests.hs +++ b/ghcide-test/exe/CodeLensTests.hs @@ -10,7 +10,6 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A import Data.Maybe import qualified Data.Text as T -import Data.Tuple.Extra import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types hiding @@ -28,6 +27,25 @@ tests = testGroup "code lenses" [ addSigLensesTests ] +data TestSpec = + TestSpec + { mName :: Maybe TestName -- ^ Optional Test Name + , input :: T.Text -- ^ Input + , expected :: Maybe T.Text -- ^ Expected Type Sig + } + +mkT :: T.Text -> T.Text -> TestSpec +mkT i e = TestSpec Nothing i (Just e) +mkT' :: TestName -> T.Text -> T.Text -> TestSpec +mkT' name i e = TestSpec (Just name) i (Just e) + +noExpected :: TestSpec -> TestSpec +noExpected t = t { expected = Nothing } + +mkTestName :: TestSpec -> String +mkTestName t = case mName t of + Nothing -> T.unpack $ T.replace "\n" "\\n" (input t) + Just name -> name addSigLensesTests :: TestTree addSigLensesTests = @@ -41,14 +59,14 @@ addSigLensesTests = , "data T1 a where" , " MkT1 :: (Show b) => a -> b -> T1 a" ] - before enableGHCWarnings exported (def, _) others = - T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, def] <> others - after' enableGHCWarnings exported (def, sig) others = - T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure sig <> [def] <> others + before enableGHCWarnings exported spec others = + T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, input spec] <> others + after' enableGHCWarnings exported spec others = + T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported] <> maybe [] pure (expected spec) <> [input spec] <> others createConfig mode = A.object ["plugin" A..= A.object ["ghcide-type-lenses" A..= A.object ["config" A..= A.object ["mode" A..= A.String mode]]]] - sigSession testName enableGHCWarnings waitForDiags mode exported def others = testWithDummyPluginEmpty testName $ do - let originalCode = before enableGHCWarnings exported def others - let expectedCode = after' enableGHCWarnings exported def others + sigSession testName enableGHCWarnings waitForDiags mode exported spec others = testWithDummyPluginEmpty testName $ do + let originalCode = before enableGHCWarnings exported spec others + let expectedCode = after' enableGHCWarnings exported spec others setConfigSection "haskell" (createConfig mode) doc <- createDoc "Sigs.hs" "haskell" originalCode -- Because the diagnostics mode is really relying only on diagnostics now @@ -58,7 +76,7 @@ addSigLensesTests = then void waitForDiagnostics else waitForProgressDone codeLenses <- getAndResolveCodeLenses doc - if not $ null $ snd def + if isJust $ expected spec then do liftIO $ length codeLenses == 1 @? "Expected 1 code lens, but got: " <> show codeLenses executeCommand $ fromJust $ head codeLenses ^. L.command @@ -66,43 +84,46 @@ addSigLensesTests = liftIO $ expectedCode @=? modifiedCode else liftIO $ null codeLenses @? "Expected no code lens, but got: " <> show codeLenses cases = - [ ("abc = True", "abc :: Bool") - , ("foo a b = a + b", "foo :: Num a => a -> a -> a") - , ("bar a b = show $ a + b", "bar :: (Show a, Num a) => a -> a -> String") - , ("(!!!) a b = a > b", "(!!!) :: Ord a => a -> a -> Bool") - , ("a >>>> b = a + b", "(>>>>) :: Num a => a -> a -> a") - , ("a `haha` b = a b", "haha :: (t1 -> t2) -> t1 -> t2") - , ("pattern Some a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just a\n where Some a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Some a <- Just !a\n where Some !a = Just a", "pattern Some :: a -> Maybe a") - , ("pattern Point{x, y} = (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern Point{x, y} <- (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)", "pattern Point :: a -> b -> (a, b)") - , ("pattern MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("pattern MkT1' b <- MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("qualifiedSigTest= C.realPart", "qualifiedSigTest :: C.Complex a -> a") - , ("head = 233", "head :: Integer") - , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, String)") - , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") - , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") - , ("typeOperatorTest = Refl", "typeOperatorTest :: forall {k} {a :: k}. a :~: a") - , ("notInScopeTest = mkCharType" - , if ghcVersion < GHC910 + [ mkT "abc = True" "abc :: Bool" + , mkT "foo a b = a + b" "foo :: Num a => a -> a -> a" + , mkT "bar a b = show $ a + b" "bar :: (Show a, Num a) => a -> a -> String" + , mkT "(!!!) a b = a > b" "(!!!) :: Ord a => a -> a -> Bool" + , mkT "a >>>> b = a + b" "(>>>>) :: Num a => a -> a -> a" + , mkT "a `haha` b = a b" "haha :: (t1 -> t2) -> t1 -> t2" + , mkT "pattern Some a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just a\n where Some a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Some a <- Just !a\n where Some !a = Just a" "pattern Some :: a -> Maybe a" + , mkT "pattern Point{x, y} = (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern Point{x, y} <- (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)" "pattern Point :: a -> b -> (a, b)" + , mkT "pattern MkT1' b = MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "pattern MkT1' b <- MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b" "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , mkT "qualifiedSigTest= C.realPart" "qualifiedSigTest :: C.Complex a -> a" + , mkT "head = 233" "head :: Integer" + , mkT "rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")" "rank2Test :: (forall a. a -> a) -> (Int, String)" + , mkT "symbolKindTest = Proxy @\"qwq\"" "symbolKindTest :: Proxy \"qwq\"" + , mkT "promotedKindTest = Proxy @Nothing" (if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") + , mkT "typeOperatorTest = Refl" "typeOperatorTest :: forall {k} {a :: k}. a :~: a" + , mkT "notInScopeTest = mkCharType" + (if ghcVersion < GHC910 then "notInScopeTest :: String -> Data.Data.DataType" else "notInScopeTest :: String -> GHC.Internal.Data.Data.DataType" ) - , ("aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n", "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool") + + , mkT' "aVeryLongSignature" + "aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n" + "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool" ] in testGroup "add signature" - [ testGroup "signatures are correct" [sigSession (T.unpack $ T.replace "\n" "\\n" def) False False "always" "" (def, Just sig) [] | (def, sig) <- cases] - , sigSession "exported mode works" False False "exported" "xyz" ("xyz = True", Just "xyz :: Bool") (fst <$> take 3 cases) + [ testGroup "signatures are correct" [sigSession (mkTestName spec) False False "always" "" spec [] | spec <- cases] + , sigSession "exported mode works" False False "exported" "xyz" (mkT "xyz = True" "xyz :: Bool") (input <$> take 3 cases) , testGroup "diagnostics mode works" - [ sigSession "with GHC warnings" True True "diagnostics" "" (second Just $ head cases) [] - , sigSession "without GHC warnings" False False "diagnostics" "" (second (const Nothing) $ head cases) [] + [ sigSession "with GHC warnings" True True "diagnostics" "" (head cases) [] + , sigSession "without GHC warnings" False False "diagnostics" "" (noExpected $ head cases) [] ] , testWithDummyPluginEmpty "keep stale lens" $ do let content = T.unlines diff --git a/ghcide-test/exe/CompletionTests.hs b/ghcide-test/exe/CompletionTests.hs index a980d47233..8c44173bd6 100644 --- a/ghcide-test/exe/CompletionTests.hs +++ b/ghcide-test/exe/CompletionTests.hs @@ -33,7 +33,6 @@ import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit - tests :: TestTree tests = testGroup "completion" @@ -61,6 +60,7 @@ completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, Co completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do docId <- openDoc "A.hs" "haskell" _ <- waitForDiagnostics + compls <- getAndResolveCompletions docId pos let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls] let emptyToMaybe x = if T.null x then Nothing else Just x @@ -211,7 +211,38 @@ localCompletionTests = [ compls <- getCompletions doc (Position 0 15) liftIO $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"] - pure () + pure (), + completionTest + "polymorphic record dot completion" + [ "{-# LANGUAGE OverloadedRecordDot #-}" + , "module A () where" + , "data Record = Record" + , " { field1 :: Int" + , " , field2 :: Int" + , " }" + , -- Without the following, this file doesn't trigger any diagnostics, so completionTest waits forever + "triggerDiag :: UnknownType" + , "foo record = record.f" + ] + (Position 7 21) + [("field1", CompletionItemKind_Function, "field1", True, False, Nothing) + ,("field2", CompletionItemKind_Function, "field2", True, False, Nothing) + ], + completionTest + "qualified polymorphic record dot completion" + [ "{-# LANGUAGE OverloadedRecordDot #-}" + , "module A () where" + , "data Record = Record" + , " { field1 :: Int" + , " , field2 :: Int" + , " }" + , "someValue = undefined" + , "foo = A.someValue.f" + ] + (Position 7 19) + [("field1", CompletionItemKind_Function, "field1", True, False, Nothing) + ,("field2", CompletionItemKind_Function, "field2", True, False, Nothing) + ] ] nonLocalCompletionTests :: [TestTree] @@ -276,8 +307,7 @@ nonLocalCompletionTests = where brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" brokenForWinOldGhc = - knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC94] "Windows (GHC == 9.4) has strange things in scope for some reason" - . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC96] "Windows (GHC == 9.6) has strange things in scope for some reason" + knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC96] "Windows (GHC == 9.6) has strange things in scope for some reason" . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC98] "Windows (GHC == 9.8) has strange things in scope for some reason" otherCompletionTests :: [TestTree] @@ -350,10 +380,11 @@ packageCompletionTests = , _label == "fromList" ] liftIO $ take 3 (sort compls') @?= - map ("Defined in "<>) ( - [ "'Data.List.NonEmpty" + map ("Defined in "<>) [ + "'Data.List.NonEmpty" , "'GHC.Exts" - ] ++ (["'GHC.IsList" | ghcVersion >= GHC94])) + , "'GHC.IsList" + ] , testSessionEmptyWithCradle "Map" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, containers, A]}}" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines diff --git a/ghcide-test/exe/CradleTests.hs b/ghcide-test/exe/CradleTests.hs index 046b8bbf2f..d79b90c835 100644 --- a/ghcide-test/exe/CradleTests.hs +++ b/ghcide-test/exe/CradleTests.hs @@ -117,7 +117,11 @@ simpleSubDirectoryTest = multiTests :: FilePath -> [TestTree] multiTests dir = - [simpleMultiTest dir, simpleMultiTest2 dir, simpleMultiTest3 dir, simpleMultiDefTest dir] + [ simpleMultiTest dir + , simpleMultiTest2 dir + , simpleMultiTest3 dir + , simpleMultiDefTest dir + ] multiTestName :: FilePath -> String -> String multiTestName dir name = "simple-" ++ dir ++ "-" ++ name diff --git a/ghcide-test/exe/DiagnosticTests.hs b/ghcide-test/exe/DiagnosticTests.hs index 615e6ad69e..52aba0b9b7 100644 --- a/ghcide-test/exe/DiagnosticTests.hs +++ b/ghcide-test/exe/DiagnosticTests.hs @@ -343,19 +343,9 @@ tests = testGroup "diagnostics" expectDiagnostics [ ( "Main.hs" , [(DiagnosticSeverity_Error, (6, 9), - if ghcVersion >= GHC96 then - "Variable not in scope: ThisList.map" - else if ghcVersion >= GHC94 then - "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 - else - "Not in scope: \8216ThisList.map\8217", Just "GHC-88464") + "Variable not in scope: ThisList.map", Just "GHC-88464") ,(DiagnosticSeverity_Error, (7, 9), - if ghcVersion >= GHC96 then - "Variable not in scope: BaseList.x" - else if ghcVersion >= GHC94 then - "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 - else - "Not in scope: \8216BaseList.x\8217", Just "GHC-88464") + "Variable not in scope: BaseList.x", Just "GHC-88464") ] ) ] @@ -373,7 +363,7 @@ tests = testGroup "diagnostics" -- where appropriate. The warning should use an unqualified name 'Ord', not -- something like 'GHC.Classes.Ord'. The choice of redundant-constraints to -- test this is fairly arbitrary. - , [(DiagnosticSeverity_Warning, (2, if ghcVersion >= GHC94 then 7 else 0), "Redundant constraint: Ord a", Just "GHC-30606") + , [(DiagnosticSeverity_Warning, (2, 7), "Redundant constraint: Ord a", Just "GHC-30606") ] ) ] diff --git a/ghcide-test/exe/FindDefinitionAndHoverTests.hs b/ghcide-test/exe/FindDefinitionAndHoverTests.hs index e46141df4e..e4c0958f58 100644 --- a/ghcide-test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide-test/exe/FindDefinitionAndHoverTests.hs @@ -187,7 +187,8 @@ tests = let holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] - reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion >= GHC94 && ghcVersion < GHC910 then mkL bar 3 5 3 8 else mkL bar 3 0 3 14] + reexported = Position 55 14 + reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion < GHC910 || not isWindows then mkL bar 3 5 3 8 else mkL bar 3 0 3 14] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]] cmtL68 = Position 67 0 ; lackOfdEq = [ExpectHoverExcludeText ["$dEq"]] import310 = Position 3 10; pkgTxt = [ExpectHoverText ["Data.Text\n\ntext-"]] @@ -237,9 +238,9 @@ tests = let , testM yes yes imported importedSig "Imported symbol" , if isWindows then -- Flaky on Windows: https://github.com/haskell/haskell-language-server/issues/2997 - testM no yes reexported reexportedSig "Imported symbol (reexported)" + testM no yes reexported reexportedSig "Imported symbol reexported" else - testM yes yes reexported reexportedSig "Imported symbol (reexported)" + testM yes yes reexported reexportedSig "Imported symbol reexported" , test no yes thLocL57 thLoc "TH Splice Hover" , test yes yes import310 pkgTxt "show package name and its version" ] diff --git a/ghcide-test/exe/ReferenceTests.hs b/ghcide-test/exe/ReferenceTests.hs index 50c263c4fc..758506e54d 100644 --- a/ghcide-test/exe/ReferenceTests.hs +++ b/ghcide-test/exe/ReferenceTests.hs @@ -115,7 +115,7 @@ tests = testGroup "references" ] , testGroup "can get references to non FOIs" - [ referenceTest "can get references to symbol defined in a module we import" + [ referenceTest "references to symbol defined in a module we import" ("References.hs", 22, 4) YesIncludeDeclaration [ ("References.hs", 22, 4) @@ -123,7 +123,7 @@ tests = testGroup "references" , ("OtherModule.hs", 4, 0) ] - , referenceTest "can get references in modules that import us to symbols we define" + , referenceTest "references in modules that import us to symbols we define" ("OtherModule.hs", 4, 0) YesIncludeDeclaration [ ("References.hs", 22, 4) @@ -131,7 +131,7 @@ tests = testGroup "references" , ("OtherModule.hs", 4, 0) ] - , referenceTest "can get references to symbol defined in a module we import transitively" + , referenceTest "references to symbol defined in a module we import transitively" ("References.hs", 24, 4) YesIncludeDeclaration [ ("References.hs", 24, 4) @@ -139,7 +139,7 @@ tests = testGroup "references" , ("OtherOtherModule.hs", 2, 0) ] - , referenceTest "can get references in modules that import us transitively to symbols we define" + , referenceTest "references in modules that transitively use symbols we define" ("OtherOtherModule.hs", 2, 0) YesIncludeDeclaration [ ("References.hs", 24, 4) @@ -147,7 +147,7 @@ tests = testGroup "references" , ("OtherOtherModule.hs", 2, 0) ] - , referenceTest "can get type references to other modules" + , referenceTest "type references to other modules" ("Main.hs", 12, 10) YesIncludeDeclaration [ ("Main.hs", 12, 7) @@ -156,6 +156,28 @@ tests = testGroup "references" , ("References.hs", 16, 0) ] ] + -- Fields.hs does not depend on Main.hs + -- so we can only find references in Fields.hs + , testGroup "references to record fields" + [ referenceTest "references record fields in the same file" + ("Fields.hs", 5, 4) + YesIncludeDeclaration + [ ("Fields.hs", 5, 4) + , ("Fields.hs", 10, 14) + , ("Fields.hs", 13, 14) + ] + + -- Main.hs depends on Fields.hs, so we can find references + -- from Main.hs to Fields.hs + , referenceTest "references record fields cross modules" + ("Main.hs", 16, 24) + YesIncludeDeclaration + [ ("Fields.hs", 5, 4) + , ("Fields.hs", 10, 14) + , ("Fields.hs", 13, 14) + , ("Main.hs", 16, 24) + ] + ] ] -- | When we ask for all references to symbol "foo", should the declaration "foo diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index c28c36296c..7dd12f9fef 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -2,7 +2,7 @@ cabal-version: 3.4 build-type: Simple category: Development name: ghcide -version: 2.10.0.0 +version: 2.11.0.0 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors @@ -14,7 +14,7 @@ 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 ==9.10.1 || ==9.8.2 || ==9.6.5 || ==9.4.8 +tested-with: GHC == {9.12.2, 9.10.1, 9.8.4, 9.6.7} extra-source-files: CHANGELOG.md README.md @@ -57,7 +57,7 @@ library , deepseq , dependent-map , dependent-sum - , Diff ^>=0.5 + , Diff ^>=0.5 || ^>=1.0.0 , directory , dlist , enummapset @@ -73,11 +73,10 @@ library , Glob , haddock-library >=1.8 && <1.12 , hashable - , hie-bios ^>=0.15.0 - , hie-compat ^>=0.3.0.0 - , hiedb ^>= 0.6.0.2 - , hls-graph == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , hie-bios ^>=0.17.0 + , hiedb ^>= 0.7.0.0 + , hls-graph == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , implicit-hie >= 0.1.4.0 && < 0.1.5 , lens , lens-aeson diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a2dbbb1e15..dde1cfdea5 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -67,6 +67,7 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC.ResponseFile import qualified HIE.Bios as HieBios +import qualified HIE.Bios.Cradle.Utils as HieBios import HIE.Bios.Environment hiding (getCacheDir) import HIE.Bios.Types hiding (Log) import qualified HIE.Bios.Types as HieBios @@ -223,7 +224,7 @@ instance Pretty Log where -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String -hiedbDataVersion = "1" +hiedbDataVersion = "2" data CacheDirs = CacheDirs { hiCacheDir, hieCacheDir, oCacheDir :: Maybe FilePath} @@ -451,6 +452,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do IdeOptions{ optTesting = IdeTesting optTesting , optCheckProject = getCheckProject , optExtensions + , optHaddockParse } <- getIdeOptions -- populate the knownTargetsVar with all the @@ -495,9 +497,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do packageSetup (hieYaml, cfp, opts, libDir) = do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv ideNc libDir - newTargetDfs <- evalGhcEnv hscEnv $ setOptions cfp opts (hsc_dflags hscEnv) rootDir + newTargetDfs <- evalGhcEnv hscEnv $ setOptions optHaddockParse cfp opts (hsc_dflags hscEnv) rootDir let deps = componentDependencies opts ++ maybeToList hieYaml - dep_info <- getDependencyInfo deps + dep_info <- getDependencyInfo (fmap toAbsolutePath deps) -- Now lookup to see whether we are combining with an existing HscEnv -- or making a new one. The lookup returns the HscEnv and a list of -- information about other components loaded into the HscEnv @@ -798,7 +800,7 @@ setNameCache nc hsc = hsc { hsc_NC = nc } -- Moved back to implementation in GHC. checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> [DriverMessages] checkHomeUnitsClosed' ue _ = checkHomeUnitsClosed ue -#elif MIN_VERSION_ghc(9,3,0) +#else -- This function checks the important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- GHC had an implementation of this function, but it was horribly inefficient @@ -888,11 +890,7 @@ newComponentCache recorder exts _cfp hsc_env old_cis new_cis = do ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp (T.pack (Compat.printWithoutUniques (singleMessage err))) -#if MIN_VERSION_ghc(9,5,0) (Just (fmap GhcDriverMessage err)) -#else - Nothing -#endif multi_errs = map closure_err_to_multi_err closure_errs bad_units = OS.fromList $ concat $ do x <- map errMsgDiagnostic closure_errs @@ -960,6 +958,8 @@ CallStack (from HasCallStack): expectJust, called at compiler\\typecheck\\FamInst.hs:461:30 in ghc:FamInst ``` +and many more. + To mitigate this, we set the cache directory for each component dependent on the components of the current `HscEnv`, additionally to the component options of the respective components. @@ -1111,12 +1111,13 @@ addUnit unit_str = liftEwM $ do -- | Throws if package flags are unsatisfiable setOptions :: GhcMonad m - => NormalizedFilePath + => OptHaddockParse + -> NormalizedFilePath -> ComponentOptions -> DynFlags -> FilePath -- ^ root dir, see Note [Root Directory] -> m (NonEmpty (DynFlags, [GHC.Target])) -setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do +setOptions haddockOpt cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do ((theOpts',_errs,_warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts) case NE.nonEmpty units of Just us -> initMulti us @@ -1146,7 +1147,10 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do initMulti unitArgFiles = forM unitArgFiles $ \f -> do args <- liftIO $ expandResponse [f] - initOne args + -- The reponse files may contain arguments like "+RTS", + -- and hie-bios doesn't expand the response files of @-unit@ arguments. + -- Thus, we need to do the stripping here. + initOne $ HieBios.removeRTS $ HieBios.removeVerbosityOpts args initOne this_opts = do (dflags', targets') <- addCmdOpts this_opts dflags let dflags'' = @@ -1177,6 +1181,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do dontWriteHieFiles $ setIgnoreInterfacePragmas $ setBytecodeLinkerOptions $ + enableOptHaddock haddockOpt $ disableOptimisation $ Compat.setUpTypedHoles $ makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory @@ -1190,6 +1195,14 @@ setIgnoreInterfacePragmas df = disableOptimisation :: DynFlags -> DynFlags disableOptimisation df = updOptLevel 0 df +-- | We always compile with '-haddock' unless explicitly disabled. +-- +-- This avoids inconsistencies when doing recompilation checking which was +-- observed in https://github.com/haskell/haskell-language-server/issues/4511 +enableOptHaddock :: OptHaddockParse -> DynFlags -> DynFlags +enableOptHaddock HaddockParse d = gopt_set d Opt_Haddock +enableOptHaddock NoHaddockParse d = d + setHiDir :: FilePath -> DynFlags -> DynFlags setHiDir f d = -- override user settings to avoid conflicts leading to recompilation diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index 0d55a73120..61614cb0ca 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -28,6 +28,7 @@ import Development.IDE.Graph import qualified Development.IDE.Spans.AtPoint as AtPoint import Development.IDE.Types.HscEnvEq (hscEnv) import Development.IDE.Types.Location +import GHC.Iface.Ext.Types (Identifier) import qualified HieDb import Language.LSP.Protocol.Types (DocumentHighlight (..), SymbolInformation (..), diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index ed5e14a70a..48439e2ff3 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -39,79 +39,78 @@ module Development.IDE.Core.Compile , setNonHomeFCHook ) where -import Control.Concurrent.STM.Stats hiding (orElse) -import Control.DeepSeq (NFData (..), force, - rnf) -import Control.Exception (evaluate) +import Control.Concurrent.STM.Stats hiding (orElse) +import Control.DeepSeq (NFData (..), + force, rnf) +import Control.Exception (evaluate) import Control.Exception.Safe -import Control.Lens hiding (List, pre, - (<.>)) +import Control.Lens hiding (List, pre, + (<.>)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Except -import qualified Control.Monad.Trans.State.Strict as S -import Data.Aeson (toJSON) -import Data.Bifunctor (first, second) +import qualified Control.Monad.Trans.State.Strict as S +import Data.Aeson (toJSON) +import Data.Bifunctor (first, second) import Data.Binary -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import Data.Coerce -import qualified Data.DList as DL +import qualified Data.DList as DL import Data.Functor import Data.Generics.Aliases import Data.Generics.Schemes -import qualified Data.HashMap.Strict as HashMap -import Data.IntMap (IntMap) +import qualified Data.HashMap.Strict as HashMap +import Data.IntMap (IntMap) import Data.IORef import Data.List.Extra -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as Map import Data.Maybe -import Data.Proxy (Proxy (Proxy)) -import qualified Data.Text as T -import Data.Time (UTCTime (..), getCurrentTime) -import Data.Tuple.Extra (dupe) +import Data.Proxy (Proxy (Proxy)) +import qualified Data.Text as T +import Data.Time (UTCTime (..)) +import Data.Tuple.Extra (dupe) import Debug.Trace -import Development.IDE.Core.FileStore (resetInterfaceStore) +import Development.IDE.Core.FileStore (resetInterfaceStore) import Development.IDE.Core.Preprocessor -import Development.IDE.Core.ProgressReporting (progressUpdate) +import Development.IDE.Core.ProgressReporting (progressUpdate) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake -import Development.IDE.Core.Tracing (withTrace) -import Development.IDE.GHC.Compat hiding (assert, - loadInterface, - parseHeader, - parseModule, - tcRnModule, - writeHieFile) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as GHC -import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.Core.Tracing (withTrace) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat.Driver (hscTypecheckRenameWithDiagnostics) +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.CoreFile import Development.IDE.GHC.Error -import Development.IDE.GHC.Orphans () +import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util import Development.IDE.GHC.Warnings +import Development.IDE.Import.DependencyInformation import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options -import GHC (ForeignHValue, - GetDocsFailure (..), - parsedSource, ModLocation (..)) -import qualified GHC.LanguageExtensions as LangExt +import GHC (ForeignHValue, + GetDocsFailure (..), + ModLocation (..), + parsedSource) +import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized -import HieDb hiding (withHieDb) -import qualified Language.LSP.Protocol.Message as LSP -import Language.LSP.Protocol.Types (DiagnosticTag (..)) -import qualified Language.LSP.Server as LSP -import Prelude hiding (mod) +import HieDb hiding (withHieDb) +import qualified Language.LSP.Protocol.Message as LSP +import Language.LSP.Protocol.Types (DiagnosticTag (..)) +import qualified Language.LSP.Server as LSP +import Prelude hiding (mod) import System.Directory import System.FilePath -import System.IO.Extra (fixIO, - newTempFileWithin) +import System.IO.Extra (fixIO, + newTempFileWithin) -import qualified Data.Set as Set -import qualified GHC as G -import qualified GHC.Runtime.Loader as Loader +import qualified Data.Set as Set +import qualified GHC as G +import GHC.Core.Lint.Interactive +import GHC.Driver.Config.CoreToStg.Prep +import GHC.Iface.Ext.Types (HieASTs) +import qualified GHC.Runtime.Loader as Loader import GHC.Tc.Gen.Splice import GHC.Types.Error import GHC.Types.ForeignStubs @@ -120,24 +119,39 @@ import GHC.Types.TypeEnv -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] - -#if MIN_VERSION_ghc(9,5,0) -import GHC.Core.Lint.Interactive -import GHC.Driver.Config.CoreToStg.Prep -#endif - #if MIN_VERSION_ghc(9,7,0) -import Data.Foldable (toList) +import Data.Foldable (toList) import GHC.Unit.Module.Warnings #else -import Development.IDE.Core.FileStore (shareFilePath) +import Development.IDE.Core.FileStore (shareFilePath) #endif -import Development.IDE.GHC.Compat.Driver (hscTypecheckRenameWithDiagnostics) +#if MIN_VERSION_ghc(9,10,0) +import Development.IDE.GHC.Compat hiding (assert, + loadInterface, + parseHeader, + parseModule, + tcRnModule, + writeHieFile) +#else +import Development.IDE.GHC.Compat hiding + (loadInterface, + parseHeader, + parseModule, + tcRnModule, + writeHieFile) +#endif + +#if MIN_VERSION_ghc(9,11,0) +import qualified Data.List.NonEmpty as NE +import Data.Time (getCurrentTime) +import GHC.Driver.Env (hsc_all_home_unit_ids) +import GHC.Iface.Ext.Types (NameEntityInfo) +#endif -import Development.IDE.Import.DependencyInformation -import GHC.Driver.Env ( hsc_all_home_unit_ids ) -import Development.IDE.Import.FindImports +#if MIN_VERSION_ghc(9,12,0) +import Development.IDE.Import.FindImports +#endif --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text @@ -176,7 +190,7 @@ computePackageDeps env pkg = do data TypecheckHelpers = TypecheckHelpers - { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files + { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files , getModuleGraph :: IO DependencyInformation } @@ -470,9 +484,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do pure (details, guts) let !partial_iface = force $ mkPartialIface session -#if MIN_VERSION_ghc(9,5,0) (cg_binds guts) -#endif details ms #if MIN_VERSION_ghc(9,11,0) @@ -481,9 +493,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do simplified_guts final_iface' <- mkFullIface session partial_iface Nothing -#if MIN_VERSION_ghc(9,4,2) Nothing -#endif #if MIN_VERSION_ghc(9,11,0) NoStubs [] #endif @@ -524,17 +534,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do mod = ms_mod ms data_tycons = filter isDataTyCon tycons CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core - -#if MIN_VERSION_ghc(9,5,0) cp_cfg <- initCorePrepConfig session -#endif - let corePrep = corePrepPgm -#if MIN_VERSION_ghc(9,5,0) (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session)) -#else - session -#endif mod (ms_location ms) -- Run corePrep first as we want to test the final version of the program that will @@ -647,11 +649,7 @@ generateObjectCode session summary guts = do (Just dot_o) $ hsc_dflags env' session' = hscSetFlags newFlags session -#if MIN_VERSION_ghc(9,4,2) (outputFilename, _mStub, _foreign_files, _cinfos, _stgcinfos) <- hscGenHardCode session' guts -#else - (outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts -#endif (ms_location summary) fp obj <- compileFile session' driverNoStop (outputFilename, Just (As False)) @@ -673,22 +671,31 @@ generateByteCode :: CoreFileTime -> HscEnv -> ModSummary -> CgGuts -> IO (IdeRes generateByteCode (CoreFileTime time) hscEnv summary guts = do fmap (either (, Nothing) (second Just)) $ catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do + #if MIN_VERSION_ghc(9,11,0) (warnings, (_, bytecode)) <- + withWarnings "bytecode" $ \_tweak -> do + let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + summary' = summary { ms_hspp_opts = hsc_dflags session } + hscInteractive session (mkCgInteractiveGuts guts) + (ms_location summary') #else (warnings, (_, bytecode, sptEntries)) <- -#endif withWarnings "bytecode" $ \_tweak -> do let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) -- TODO: maybe settings ms_hspp_opts is unnecessary? summary' = summary { ms_hspp_opts = hsc_dflags session } hscInteractive session (mkCgInteractiveGuts guts) (ms_location summary') +#endif + #if MIN_VERSION_ghc(9,11,0) let linkable = Linkable time (ms_mod summary) (pure $ BCOs bytecode) #else let linkable = LM time (ms_mod summary) [BCOs bytecode sptEntries] #endif + pure (map snd warnings, linkable) demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule @@ -821,7 +828,7 @@ generateHieAsts hscEnv tcm = pure $ Just $ #if MIN_VERSION_ghc(9,11,0) hie_asts (tcg_type_env ts) -#elif MIN_VERSION_ghc(9,3,0) +#else hie_asts #endif where @@ -966,12 +973,12 @@ handleGenerationErrors' dflags source action = ) ] - -- Merge the HPTs, module graphs and FinderCaches -- See Note [GhcSessionDeps] in Development.IDE.Core.Rules -- Add the current ModSummary to the graph, along with the -- HomeModInfo's of all direct dependencies (by induction hypothesis all -- transitive dependencies will be contained in envs) +#if MIN_VERSION_ghc(9,11,0) mergeEnvs :: HscEnv -> ModuleGraph -> DependencyInformation @@ -980,7 +987,6 @@ mergeEnvs :: HscEnv -> [HscEnv] -> IO HscEnv mergeEnvs env mg dep_info ms extraMods envs = do -#if MIN_VERSION_ghc(9,11,0) return $! loadModulesHome extraMods $ let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in (hscUpdateHUG (const newHug) env){ @@ -1011,7 +1017,15 @@ mergeEnvs env mg dep_info ms extraMods envs = do | HsSrcFile <- mi_hsc_src (hm_iface a) = a | otherwise = b -#elif MIN_VERSION_ghc(9,3,0) +#else +mergeEnvs :: HscEnv + -> ModuleGraph + -> DependencyInformation + -> ModSummary + -> [HomeModInfo] + -> [HscEnv] + -> IO HscEnv +mergeEnvs env mg _dep_info ms extraMods envs = do let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) ifr = InstalledFound (ms_location ms) im curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr @@ -1173,11 +1187,7 @@ parseHeader => DynFlags -- ^ flags to use -> FilePath -- ^ the filename (for source locations) -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) -#if MIN_VERSION_ghc(9,5,0) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located (HsModule GhcPs)) -#else - -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located HsModule) -#endif parseHeader dflags filename contents = do let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of @@ -1439,7 +1449,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do | not (mi_used_th iface) = emptyModuleEnv | otherwise = parseRuntimeDeps (md_anns details) -- Peform the fine grained recompilation check for TH - maybe_recomp <- checkLinkableDependencies session get_linkable_hashes get_module_graph runtime_deps + maybe_recomp <- checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps case maybe_recomp of Just msg -> do_regenerate msg Nothing @@ -1476,8 +1486,8 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns -- the runtime dependencies of the module, to check if any of them are out of date -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH -- See Note [Recompilation avoidance in the presence of TH] -checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) -checkLinkableDependencies hsc_env get_linkable_hashes get_module_graph runtime_deps = do +checkLinkableDependencies :: MonadIO m => ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) +checkLinkableDependencies get_linkable_hashes get_module_graph runtime_deps = do graph <- get_module_graph let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph hs_files = mapM go (moduleEnvToList runtime_deps) @@ -1523,16 +1533,12 @@ coreFileToCgGuts session iface details core_file = do -- Implicit binds aren't saved, so we need to regenerate them ourselves. let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6 tyCons = typeEnvTyCons (md_types details) -#if MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, the implicit binds are tidied and part of core_binds pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty #if !MIN_VERSION_ghc(9,11,0) (emptyHpcInfo False) #endif Nothing [] -#else - pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] -#endif coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDetails -> CoreFile -> UTCTime -> IO ([FileDiagnostic], Maybe HomeModInfo) coreFileToLinkable linkableType session ms iface details core_file t = do @@ -1637,7 +1643,7 @@ setNonHomeFCHook hsc_env = with negative if clauses coming before positive if clauses of the same version. (If you think about which GHC version a clause activates for this should make sense `!MIN_VERSION_GHC(9,0,0)` refers to 8.10 and lower which is - a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 + an earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 and later). In addition there should be a space before and after each CPP clause. diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 3de21e175d..e545ec7b14 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -78,7 +78,6 @@ import System.FilePath import System.IO.Error import System.IO.Unsafe - data Log = LogCouldNotIdentifyReverseDeps !NormalizedFilePath | LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath]) @@ -147,6 +146,29 @@ getModificationTimeImpl missingFileDiags file = do then return (Nothing, ([], Nothing)) else return (Nothing, ([diag], Nothing)) + +getPhysicalModificationTimeRule :: Recorder (WithPriority Log) -> Rules () +getPhysicalModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetPhysicalModificationTime file -> + getPhysicalModificationTimeImpl file + +getPhysicalModificationTimeImpl + :: NormalizedFilePath + -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion)) +getPhysicalModificationTimeImpl file = do + let file' = fromNormalizedFilePath file + let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time)) + + alwaysRerun + + liftIO $ fmap wrap (getModTime file') + `catch` \(e :: IOException) -> do + let err | isDoesNotExistError e = "File does not exist: " ++ file' + | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e + diag = ideErrorText file (T.pack err) + if isDoesNotExistError e + then return (Nothing, ([], Nothing)) + else return (Nothing, ([diag], Nothing)) + -- | Interface files cannot be watched, since they live outside the workspace. -- But interface files are private, in that only HLS writes them. -- So we implement watching ourselves, and bypass the need for alwaysRerun. @@ -170,7 +192,11 @@ resetFileStore ideState changes = mask $ \_ -> do case c of LSP.FileChangeType_Changed -- already checked elsewhere | not $ HM.member nfp fois - -> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp + -> + atomically $ do + ks <- deleteValue (shakeExtras ideState) GetModificationTime nfp + vs <- deleteValue (shakeExtras ideState) GetPhysicalModificationTime nfp + pure $ ks ++ vs _ -> pure [] @@ -233,6 +259,7 @@ getVersionedTextDoc doc = do fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () fileStoreRules recorder isWatched = do getModificationTimeRule recorder + getPhysicalModificationTimeRule recorder getFileContentsRule recorder addWatchedFileRule recorder isWatched @@ -264,7 +291,7 @@ typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) pa typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action () typecheckParentsAction recorder nfp = do - revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph + revs <- transitiveReverseDependencies nfp <$> useWithSeparateFingerprintRule_ GetModuleGraphTransReverseDepsFingerprints GetModuleGraph nfp case revs of Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp Just rs -> do diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 2a594c1021..19e0f40e24 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -29,7 +29,6 @@ import Development.IDE.Graph import Control.Concurrent.STM.Stats (atomically, modifyTVar') import Data.Aeson (toJSON) -import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS import Data.Maybe (catMaybes) import Development.IDE.Core.ProgressReporting diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index c4f88de047..a13e6de14c 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -1,6 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} @@ -34,6 +35,9 @@ import Development.IDE.Import.DependencyInformation import Development.IDE.Types.HscEnvEq (HscEnvEq) import Development.IDE.Types.KnownTargets import GHC.Generics (Generic) +import GHC.Iface.Ext.Types (HieASTs, + TypeIndex) +import GHC.Iface.Ext.Utils (RefMap) import Data.ByteString (ByteString) import Data.Text.Utf16.Rope.Mixed (Rope) @@ -74,6 +78,12 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule type instance RuleResult GetModuleGraph = DependencyInformation +-- | it only compute the fingerprint of the module graph for a file and its dependencies +-- we need this to trigger recompilation when the sub module graph for a file changes +type instance RuleResult GetModuleGraphTransDepsFingerprints = Fingerprint +type instance RuleResult GetModuleGraphTransReverseDepsFingerprints = Fingerprint +type instance RuleResult GetModuleGraphImmediateReverseDepsFingerprints = Fingerprint + data GetKnownTargets = GetKnownTargets deriving (Show, Generic, Eq, Ord) instance Hashable GetKnownTargets @@ -310,6 +320,13 @@ instance Hashable GetModificationTime where instance NFData GetModificationTime +data GetPhysicalModificationTime = GetPhysicalModificationTime + deriving (Generic, Show, Eq) + deriving anyclass (Hashable, NFData) + +-- | Get the modification time of a file on disk, ignoring any version in the VFS. +type instance RuleResult GetPhysicalModificationTime = FileVersion + pattern GetModificationTime :: GetModificationTime pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True} @@ -417,6 +434,21 @@ data GetModuleGraph = GetModuleGraph instance Hashable GetModuleGraph instance NFData GetModuleGraph +data GetModuleGraphTransDepsFingerprints = GetModuleGraphTransDepsFingerprints + deriving (Eq, Show, Generic) +instance Hashable GetModuleGraphTransDepsFingerprints +instance NFData GetModuleGraphTransDepsFingerprints + +data GetModuleGraphTransReverseDepsFingerprints = GetModuleGraphTransReverseDepsFingerprints + deriving (Eq, Show, Generic) +instance Hashable GetModuleGraphTransReverseDepsFingerprints +instance NFData GetModuleGraphTransReverseDepsFingerprints + +data GetModuleGraphImmediateReverseDepsFingerprints = GetModuleGraphImmediateReverseDepsFingerprints + deriving (Eq, Show, Generic) +instance Hashable GetModuleGraphImmediateReverseDepsFingerprints +instance NFData GetModuleGraphImmediateReverseDepsFingerprints + data ReportImportCycles = ReportImportCycles deriving (Eq, Show, Generic) instance Hashable ReportImportCycles diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 74eddf55f1..c123c9d4a8 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -138,6 +138,8 @@ import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Location import Development.IDE.Types.Options import qualified Development.IDE.Types.Shake as Shake +import GHC.Iface.Ext.Types (HieASTs (..)) +import GHC.Iface.Ext.Utils (generateReferencesMap) import qualified GHC.LanguageExtensions as LangExt import HIE.Bios.Ghc.Gap (hostIsDynamic) import qualified HieDb @@ -159,10 +161,10 @@ import Ide.Plugin.Properties (HasProperty, usePropertyByPath) import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser), PluginId) +import qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Protocol.Message (SMethod (SMethod_CustomMethod, SMethod_WindowShowMessage)) import Language.LSP.Protocol.Types (MessageType (MessageType_Info), ShowMessageParams (ShowMessageParams)) -import qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Server (LspT) import qualified Language.LSP.Server as LSP import Language.LSP.VFS @@ -174,8 +176,6 @@ import System.Info.Extra (isWindows) import qualified Data.IntMap as IM import GHC.Fingerprint -import GHC.Driver.Env (hsc_all_home_unit_ids) - data Log = LogShake Shake.Log | LogReindexingHieFile !NormalizedFilePath @@ -183,6 +183,7 @@ data Log | LogLoadingHieFileFail !FilePath !SomeException | LogLoadingHieFileSuccess !FilePath | LogTypecheckedFOI !NormalizedFilePath + | LogDependencies !NormalizedFilePath [FilePath] deriving Show instance Pretty Log where @@ -207,6 +208,11 @@ instance Pretty Log where <+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which" <+> "triggered this warning." ] + LogDependencies nfp deps -> + vcat + [ "Add dependency" <+> pretty (fromNormalizedFilePath nfp) + , nest 2 $ pretty deps + ] templateHaskellInstructions :: T.Text templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries" @@ -262,12 +268,10 @@ getParsedModuleRule recorder = let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - -- We still parse with Haddocks whether Opt_Haddock is True or False to collect information - -- but we no longer need to parse with and without Haddocks separately for above GHC90. - liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file (withOptHaddock ms) + liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file ms -withOptHaddock :: ModSummary -> ModSummary -withOptHaddock = withOption Opt_Haddock +withoutOptHaddock :: ModSummary -> ModSummary +withoutOptHaddock = withoutOption Opt_Haddock withOption :: GeneralFlag -> ModSummary -> ModSummary withOption opt ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt} @@ -286,7 +290,7 @@ getParsedModuleWithCommentsRule recorder = ModSummaryResult{msrModSummary = ms, msrHscEnv = hsc} <- use_ GetModSummary file opt <- getIdeOptions - let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms + let ms' = withoutOptHaddock $ withOption Opt_KeepRawTokenStream ms modify_dflags <- getModifyDynFlags dynFlagsModifyParser let ms'' = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } @@ -472,7 +476,7 @@ rawDependencyInformation fs = do reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules () reportImportCyclesRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ReportImportCycles file -> fmap (\errs -> if null errs then (Just "1",([], Just ())) else (Nothing, (errs, Nothing))) $ do - DependencyInformation{..} <- useNoFile_ GetModuleGraph + DependencyInformation{..} <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file case pathToId depPathIdMap file of -- The header of the file does not parse, so it can't be part of any import cycles. Nothing -> pure [] @@ -514,7 +518,7 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file) Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf) - let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res + let refmap = generateReferencesMap . getAsts . Compat.hie_asts $ res del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver) @@ -542,8 +546,8 @@ getHieAstRuleDefinition f hsc tmr = do liftIO $ writeAndIndexHieFile hsc se modSummary f exports asts source _ -> pure [] - let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts - typemap = AtPoint.computeTypeReferences . Compat.getAsts <$> masts + let refmap = generateReferencesMap . getAsts <$> masts + typemap = AtPoint.computeTypeReferences . getAsts <$> masts pure (diags <> diagsWrite, HAR (ms_mod $ tmrModSummary tmr) <$> masts <*> refmap <*> typemap <*> pure HieFresh) getImportMapRule :: Recorder (WithPriority Log) -> Rules () @@ -608,7 +612,7 @@ typeCheckRule recorder = define (cmapWithPrio LogShake recorder) $ \TypeCheck fi -- very expensive. when (foi == NotFOI) $ logWith recorder Logger.Warning $ LogTypecheckedFOI file - typeCheckRuleDefinition hsc pm + typeCheckRuleDefinition hsc pm file knownFilesRule :: Recorder (WithPriority Log) -> Rules () knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do @@ -643,7 +647,10 @@ dependencyInfoForFiles fs = do go (Just ms) _ = Just $ ModuleNode [] ms go _ _ = Nothing mg = mkModuleGraph mns - pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg) + let shallowFingers = IntMap.fromList $ foldr' (\(i, m) acc -> case m of + Just x -> (getFilePathId i,msrFingerprint x):acc + Nothing -> acc) [] $ zip _all_ids msrs + pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg shallowFingers) -- This is factored out so it can be directly called from the GetModIface -- rule. Directly calling this rule means that on the initial load we can @@ -652,14 +659,15 @@ dependencyInfoForFiles fs = do typeCheckRuleDefinition :: HscEnv -> ParsedModule + -> NormalizedFilePath -> Action (IdeResult TcModuleResult) -typeCheckRuleDefinition hsc pm = do +typeCheckRuleDefinition hsc pm fp = do IdeOptions { optDefer = defer } <- getIdeOptions unlift <- askUnliftIO let dets = TypecheckHelpers { getLinkables = unliftIO unlift . uses_ GetLinkable - , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph + , getModuleGraph = unliftIO unlift $ useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph fp } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -713,7 +721,8 @@ loadGhcSession recorder ghcSessionDepsConfig = do let nfp = toNormalizedFilePath' fp itExists <- getFileExists nfp when itExists $ void $ do - use_ GetModificationTime nfp + use_ GetPhysicalModificationTime nfp + logWith recorder Logger.Info $ LogDependencies file deps mapM_ addDependency deps let cutoffHash = LBS.toStrict $ B.encode (hash (snd val)) @@ -756,9 +765,10 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps ifaces <- uses_ GetModIface deps let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces + de <- useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph file mg <- do if fullModuleGraph - then depModuleGraph <$> useNoFile_ GetModuleGraph + then return $ depModuleGraph de else do let mgs = map hsc_mod_graph depSessions -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph @@ -771,7 +781,6 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs) liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes return $ mkModuleGraph module_graph_nodes - de <- useNoFile_ GetModuleGraph session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new @@ -801,7 +810,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco , old_value = m_old , get_file_version = use GetModificationTime_{missingFileDiagnostics = False} , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs - , get_module_graph = useNoFile_ GetModuleGraph + , get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f , regenerate = regenerateHiFile session f ms } hsc_env' <- setFileCacheHook (hscEnv session) @@ -970,14 +979,14 @@ regenerateHiFile sess f ms compNeeded = do hsc <- setFileCacheHook (hscEnv sess) opt <- getIdeOptions - -- Embed haddocks in the interface file - (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) + -- By default, we parse with `-haddock` unless 'OptHaddockParse' is overwritten. + (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms case mb_pm of Nothing -> return (diags, Nothing) Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm + (diags', mtmr) <- typeCheckRuleDefinition hsc pm f case mtmr of Nothing -> pure (diags', Nothing) Just tmr -> do @@ -1135,7 +1144,7 @@ needsCompilationRule file | "boot" `isSuffixOf` fromNormalizedFilePath file = pure (Just $ encodeLinkableType Nothing, Just Nothing) needsCompilationRule file = do - graph <- useNoFile GetModuleGraph + graph <- useWithSeparateFingerprintRule GetModuleGraphImmediateReverseDepsFingerprints GetModuleGraph file res <- case graph of -- Treat as False if some reverse dependency header fails to parse Nothing -> pure Nothing @@ -1247,6 +1256,19 @@ mainRule recorder RulesConfig{..} = do persistentDocMapRule persistentImportMapRule getLinkableRule recorder + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + let finger = lookupFingerprint file di (depTransDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphTransReverseDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + let finger = lookupFingerprint file di (depTransReverseDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModuleGraphImmediateReverseDepsFingerprints file -> do + di <- useNoFile_ GetModuleGraph + let finger = lookupFingerprint file di (depImmediateReverseDepsFingerprints di) + return (fingerprintToBS <$> finger, ([], finger)) + -- | Get HieFile for haskell file on NormalizedFilePath getHieFile :: NormalizedFilePath -> Action (Maybe HieFile) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 97150339d0..6fc9a4d00e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -31,6 +31,8 @@ module Development.IDE.Core.Shake( shakeEnqueue, newSession, use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction, + useWithSeparateFingerprintRule, + useWithSeparateFingerprintRule_, FastResult(..), use_, useNoFile_, uses_, useWithStale, usesWithStale, @@ -1148,6 +1150,23 @@ usesWithStale key files = do -- whether the rule succeeded or not. traverse (lastValue key) files +-- we use separate fingerprint rules to trigger the rebuild of the rule +useWithSeparateFingerprintRule + :: (IdeRule k v, IdeRule k1 Fingerprint) + => k1 -> k -> NormalizedFilePath -> Action (Maybe v) +useWithSeparateFingerprintRule fingerKey key file = do + _ <- use fingerKey file + useWithoutDependency key emptyFilePath + +-- we use separate fingerprint rules to trigger the rebuild of the rule +useWithSeparateFingerprintRule_ + :: (IdeRule k v, IdeRule k1 Fingerprint) + => k1 -> k -> NormalizedFilePath -> Action v +useWithSeparateFingerprintRule_ fingerKey key file = do + useWithSeparateFingerprintRule fingerKey key file >>= \case + Just v -> return v + Nothing -> liftIO $ throwIO $ BadDependency (show key) + useWithoutDependency :: IdeRule k v => k -> NormalizedFilePath -> Action (Maybe v) useWithoutDependency key file = diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index bb4c4e4e81..c97afd90e7 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -19,16 +19,10 @@ import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC import GHC.Settings +import qualified GHC.SysTools.Cpp as Pipeline -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,5,0) -import qualified GHC.Driver.Pipeline.Execute as Pipeline -#endif - -#if MIN_VERSION_ghc(9,5,0) -import qualified GHC.SysTools.Cpp as Pipeline -#endif #if MIN_VERSION_ghc(9,10,2) import qualified GHC.SysTools.Tasks as Pipeline @@ -49,13 +43,12 @@ addOptP f = alterToolSettings $ \s -> s doCpp :: HscEnv -> FilePath -> FilePath -> IO () doCpp env input_fn output_fn = - -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850 - -- this function/Pipeline.doCpp previously had a raw parameter - -- always set to True that corresponded to these settings - -#if MIN_VERSION_ghc(9,5,0) + -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850 + -- this function/Pipeline.doCpp previously had a raw parameter + -- always set to True that corresponded to these settings let cpp_opts = Pipeline.CppOpts { cppLinePragmas = True + #if MIN_VERSION_ghc(9,10,2) , sourceCodePreprocessor = Pipeline.SCPHsCpp #elif MIN_VERSION_ghc(9,10,0) @@ -63,10 +56,8 @@ doCpp env input_fn output_fn = #else , cppUseCc = False #endif + } in -#else - let cpp_opts = True in -#endif Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 6a2ae5b77a..befd22c8de 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -45,8 +45,6 @@ module Development.IDE.GHC.Compat( readHieFile, setHieDir, dontWriteHieFiles, - module Compat.HieTypes, - module Compat.HieUtils, -- * Compat modules module Development.IDE.GHC.Compat.Core, module Development.IDE.GHC.Compat.Env, @@ -102,9 +100,7 @@ module Development.IDE.GHC.Compat( Dependencies(dep_direct_mods), NameCacheUpdater, -#if MIN_VERSION_ghc(9,5,0) XModulePs(..), -#endif #if !MIN_VERSION_ghc(9,7,0) liftZonkM, @@ -114,14 +110,8 @@ module Development.IDE.GHC.Compat( #if MIN_VERSION_ghc(9,7,0) tcInitTidyEnv, #endif - ) where -import Compat.HieAst (enrichHie) -import Compat.HieBin -import Compat.HieTypes hiding - (nodeAnnotations) -import qualified Compat.HieTypes as GHC (nodeAnnotations) -import Compat.HieUtils + ) where import Control.Applicative ((<|>)) import qualified Data.ByteString as BS import Data.Coerce (coerce) @@ -148,12 +138,18 @@ import GHC.Core.Tidy (tidyExpr) import GHC.CoreToStg.Prep (corePrepPgm) import qualified GHC.CoreToStg.Prep as GHC import GHC.Driver.Hooks (hscCompileCoreExprHook) +import GHC.Iface.Ext.Types hiding + (nodeAnnotations) +import qualified GHC.Iface.Ext.Types as GHC (nodeAnnotations) +import GHC.Iface.Ext.Utils import GHC.ByteCode.Asm (bcoFreeNames) import GHC.Core import GHC.Data.FastString import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) +import GHC.Iface.Ext.Ast (enrichHie) +import GHC.Iface.Ext.Binary import GHC.Iface.Make (mkIfaceExports) import GHC.SysTools.Tasks (runPp, runUnlit) import GHC.Types.Annotations (AnnTarget (ModuleTarget), @@ -167,8 +163,13 @@ import GHC.Types.Var.Env import GHC.Builtin.Uniques import GHC.ByteCode.Types +import GHC.Core.Lint.Interactive (interactiveInScope) import GHC.CoreToStg import GHC.Data.Maybe +import GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr) +import GHC.Driver.Config.Core.Opt.Simplify (initSimplifyExprOpts) +import GHC.Driver.Config.CoreToStg (initCoreToStgOpts) +import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) import GHC.Driver.Config.Stg.Pipeline import GHC.Driver.Env as Env import GHC.Iface.Env @@ -188,18 +189,6 @@ import GHC.Unit.Module.ModIface -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,5,0) -import GHC.Core.Lint (lintInteractiveExpr) -#endif - -#if MIN_VERSION_ghc(9,5,0) -import GHC.Core.Lint.Interactive (interactiveInScope) -import GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr) -import GHC.Driver.Config.Core.Opt.Simplify (initSimplifyExprOpts) -import GHC.Driver.Config.CoreToStg (initCoreToStgOpts) -import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) -#endif - #if MIN_VERSION_ghc(9,7,0) import GHC.Tc.Zonk.TcType (tcInitTidyEnv) #endif @@ -230,11 +219,7 @@ myCoreToStgExpr logger dflags ictxt binding for the stg2stg step) -} let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel") (mkPseudoUniqueE 0) -#if MIN_VERSION_ghc(9,5,0) ManyTy -#else - Many -#endif (exprType prepd_expr) (stg_binds, prov_map, collected_ccs) <- myCoreToStg logger @@ -258,27 +243,17 @@ myCoreToStg logger dflags ictxt let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg -#if MIN_VERSION_ghc(9,5,0) (initCoreToStgOpts dflags) -#else - dflags -#endif this_mod ml prepd_binds #if MIN_VERSION_ghc(9,8,0) (unzip -> (stg_binds2,_),_) -#elif MIN_VERSION_ghc(9,4,2) - (stg_binds2,_) #else - stg_binds2 + (stg_binds2,_) #endif <- {-# SCC "Stg2Stg" #-} stg2stg logger -#if MIN_VERSION_ghc(9,5,0) (interactiveInScope ictxt) -#else - ictxt -#endif (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds return (stg_binds2, denv, cost_centre_info) @@ -293,42 +268,21 @@ getDependentMods :: ModIface -> [ModuleName] getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr -#if MIN_VERSION_ghc(9,5,0) simplifyExpr _ env = GHC.simplifyExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) (ue_eps (Development.IDE.GHC.Compat.Env.hsc_unit_env env)) (initSimplifyExprOpts (hsc_dflags env) (hsc_IC env)) -#else -simplifyExpr _ = GHC.simplifyExpr -#endif corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr -#if MIN_VERSION_ghc(9,5,0) corePrepExpr _ env expr = do cfg <- initCorePrepConfig env GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg expr -#else -corePrepExpr _ = GHC.corePrepExpr -#endif renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg) renderMessages msgs = -#if MIN_VERSION_ghc(9,5,0) let renderMsgs extractor = (fmap . fmap) GhcPsMessage . getMessages $ extractor msgs in (renderMsgs psWarnings, renderMsgs psErrors) -#else - let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs - in (renderMsgs psWarnings, renderMsgs psErrors) -#endif -#if MIN_VERSION_ghc(9,5,0) pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope GhcMessage)) -> ParseResult a -#else -pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a -#endif pattern PFailedWithErrorMessages msgs -#if MIN_VERSION_ghc(9,5,0) <- PFailed (const . fmap (fmap GhcPsMessage) . getMessages . getPsErrorMessages -> msgs) -#else - <- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs) -#endif {-# COMPLETE POk, PFailedWithErrorMessages #-} hieExportNames :: HieFile -> [(SrcSpan, Name)] @@ -453,8 +407,7 @@ generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a) generatedNodeInfo = Map.lookup GeneratedInfo . getSourcedNodeInfo . sourcedNodeInfo data GhcVersion - = GHC94 - | GHC96 + = GHC96 | GHC98 | GHC910 | GHC912 @@ -470,10 +423,8 @@ ghcVersion = GHC912 ghcVersion = GHC910 #elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) ghcVersion = GHC98 -#elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) +#else ghcVersion = GHC96 -#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) -ghcVersion = GHC94 #endif simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a @@ -510,14 +461,8 @@ loadModulesHome mod_infos e = recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int recDotDot x = -#if MIN_VERSION_ghc(9,5,0) unRecFieldsDotDot <$> -#endif unLoc <$> rec_dotdot x -#if MIN_VERSION_ghc(9,5,0) -extract_cons (NewTypeCon x) = [x] +extract_cons (NewTypeCon x) = [x] extract_cons (DataTypeCons _ xs) = xs -#else -extract_cons = id -#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 3f19cd7489..42f654b609 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -225,6 +225,7 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.noSrcSpan, SrcLoc.noSrcLoc, SrcLoc.noLoc, + SrcLoc.srcSpanToRealSrcSpan, mapLoc, -- * Finder FindResult(..), @@ -374,27 +375,13 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Unit.Finder.Types, module GHC.Unit.Env, module GHC.Driver.Phases, -#if !MIN_VERSION_ghc(9,4,0) - pattern HsFieldBind, - hfbAnn, - hfbLHS, - hfbRHS, - hfbPun, -#endif -#if !MIN_VERSION_ghc_boot_th(9,4,1) - Extension(.., NamedFieldPuns), -#else Extension(..), -#endif mkCgInteractiveGuts, justBytecode, justObjects, emptyHomeModInfoLinkable, homeModInfoByteCode, homeModInfoObject, -#if !MIN_VERSION_ghc(9,5,0) - field_label, -#endif groupOrigin, isVisibleFunArg, #if MIN_VERSION_ghc(9,8,0) @@ -629,21 +616,11 @@ pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr #endif isVisibleFunArg :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Bool -#if __GLASGOW_HASKELL__ >= 906 isVisibleFunArg = TypesVar.isVisibleFunArg type FunTyFlag = TypesVar.FunTyFlag -#else -isVisibleFunArg VisArg = True -isVisibleFunArg _ = False -type FunTyFlag = TypesVar.AnonArgFlag -#endif pattern FunTy :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Type -> Type -> Type pattern FunTy af arg res <- TyCoRep.FunTy {ft_af = af, ft_arg = arg, ft_res = res} - --- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x) --- type HasSrcSpan x = () :: Constraint - class HasSrcSpan a where getLoc :: a -> SrcSpan @@ -749,11 +726,7 @@ makeSimpleDetails hsc_env = mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> Maybe CoreProgram -> TcGblEnv -> IO ModIface mkIfaceTc hscEnv shm md _ms _mcp = -#if MIN_VERSION_ghc(9,5,0) GHC.mkIfaceTc hscEnv shm md _ms _mcp -- mcp::Maybe CoreProgram is only used in GHC >= 9.6 -#else - GHC.mkIfaceTc hscEnv shm md _ms -- ms::ModSummary is only used in GHC >= 9.4 -#endif mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails mkBootModDetailsTc session = GHC.mkBootModDetailsTc @@ -767,50 +740,10 @@ initTidyOpts = driverNoStop :: StopPhase driverNoStop = NoStop - -#if !MIN_VERSION_ghc(9,4,0) -pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg -pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where - HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun -#endif - -#if !MIN_VERSION_ghc_boot_th(9,4,1) -pattern NamedFieldPuns :: Extension -pattern NamedFieldPuns = RecordPuns -#endif - groupOrigin :: MatchGroup GhcRn body -> Origin -#if MIN_VERSION_ghc(9,5,0) mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b mapLoc = fmap groupOrigin = mg_ext -#else -mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b -mapLoc = SrcLoc.mapLoc -groupOrigin = mg_origin -#endif - - -#if !MIN_VERSION_ghc(9,5,0) -mkCgInteractiveGuts :: CgGuts -> CgGuts -mkCgInteractiveGuts = id - -emptyHomeModInfoLinkable :: Maybe Linkable -emptyHomeModInfoLinkable = Nothing - -justBytecode :: Linkable -> Maybe Linkable -justBytecode = Just - -justObjects :: Linkable -> Maybe Linkable -justObjects = Just - -homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable -homeModInfoByteCode = hm_linkable -homeModInfoObject = hm_linkable - -field_label :: a -> a -field_label = id -#endif mkSimpleTarget :: DynFlags -> FilePath -> Target mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Nothing diff --git a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs index 3ad063936e..6ab1d26df2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs @@ -79,11 +79,7 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do tc_result0 <- tcRnModule' mod_summary keep_rn' hpm if hsc_src == HsigFile then -#if MIN_VERSION_ghc(9,5,0) do (iface, _) <- liftIO $ hscSimpleIface hsc_env Nothing tc_result0 mod_summary -#else - do (iface, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 mod_summary -#endif ioMsgMaybe $ hoistTcRnMessage $ tcRnMergeSignatures hsc_env hpm tc_result0 iface else return tc_result0 @@ -135,7 +131,6 @@ extract_renamed_stuff mod_summary tc_result = do -- ============================================================================ -- DO NOT EDIT - Refer to top of file -- ============================================================================ -#if MIN_VERSION_ghc(9,5,0) hscSimpleIface :: HscEnv -> Maybe CoreProgram -> TcGblEnv @@ -143,13 +138,5 @@ hscSimpleIface :: HscEnv -> IO (ModIface, ModDetails) hscSimpleIface hsc_env mb_core_program tc_result summary = runHsc hsc_env $ hscSimpleIface' mb_core_program tc_result summary -#else -hscSimpleIface :: HscEnv - -> TcGblEnv - -> ModSummary - -> IO (ModIface, ModDetails) -hscSimpleIface hsc_env tc_result summary - = runHsc hsc_env $ hscSimpleIface' tc_result summary -#endif #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 988739e3b8..cbccc1a3de 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -105,22 +105,14 @@ hscHomeUnit = setBytecodeLinkerOptions :: DynFlags -> DynFlags setBytecodeLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,5,0) , backend = noBackend -#else - , backend = NoBackend -#endif , ghcMode = CompManager } setInterpreterLinkerOptions :: DynFlags -> DynFlags setInterpreterLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,5,0) , backend = interpreterBackend -#else - , backend = Interpreter -#endif , ghcMode = CompManager } diff --git a/ghcide/src/Development/IDE/GHC/Compat/Error.hs b/ghcide/src/Development/IDE/GHC/Compat/Error.hs index 06b6a9876b..de59afa146 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Error.hs @@ -8,6 +8,7 @@ module Development.IDE.GHC.Compat.Error ( -- * Error messages for the typechecking and renamer phase TcRnMessage (..), TcRnMessageDetailed (..), + Hole(..), stripTcRnMessageContext, -- * Parsing error message PsMessage(..), @@ -17,21 +18,49 @@ module Development.IDE.GHC.Compat.Error ( DriverMessage (..), -- * General Diagnostics Diagnostic(..), - -- * Prisms for error selection + -- * Prisms and lenses for error selection _TcRnMessage, + _TcRnMessageWithCtx, _GhcPsMessage, _GhcDsMessage, _GhcDriverMessage, + _ReportHoleError, + _TcRnIllegalWildcardInType, + _TcRnPartialTypeSignatures, + _TcRnMissingSignature, + _TcRnSolverReport, + _TcRnMessageWithInfo, + _TypeHole, + _ConstraintHole, + reportContextL, + reportContentL, + _MismatchMessage, + _TypeEqMismatchActual, + _TypeEqMismatchExpected, ) where import Control.Lens +import Development.IDE.GHC.Compat (Type) import GHC.Driver.Errors.Types import GHC.HsToCore.Errors.Types import GHC.Tc.Errors.Types +import GHC.Tc.Types.Constraint (Hole (..), HoleSort) import GHC.Types.Error -_TcRnMessage :: Prism' GhcMessage TcRnMessage -_TcRnMessage = prism' GhcTcRnMessage (\case +-- | Some 'TcRnMessage's are nested in other constructors for additional context. +-- For example, 'TcRnWithHsDocContext' and 'TcRnMessageWithInfo'. +-- However, in most occasions you don't need the additional context and you just want +-- the error message. @'_TcRnMessage'@ recursively unwraps these constructors, +-- until there are no more constructors with additional context. +-- +-- Use @'_TcRnMessageWithCtx'@ if you need the additional context. You can always +-- strip it later using @'stripTcRnMessageContext'@. +-- +_TcRnMessage :: Fold GhcMessage TcRnMessage +_TcRnMessage = _TcRnMessageWithCtx . to stripTcRnMessageContext + +_TcRnMessageWithCtx :: Prism' GhcMessage TcRnMessage +_TcRnMessageWithCtx = prism' GhcTcRnMessage (\case GhcTcRnMessage tcRnMsg -> Just tcRnMsg _ -> Nothing) @@ -66,3 +95,42 @@ stripTcRnMessageContext = \case msgEnvelopeErrorL :: Lens' (MsgEnvelope e) e msgEnvelopeErrorL = lens errMsgDiagnostic (\envelope e -> envelope { errMsgDiagnostic = e } ) + +makePrisms ''TcRnMessage + +makeLensesWith + (lensRules & lensField .~ mappingNamer (pure . (++ "L"))) + ''SolverReportWithCtxt + +makePrisms ''TcSolverReportMsg + +makePrisms ''HoleSort + +-- | Focus 'MismatchMsg' from 'TcSolverReportMsg'. Currently, 'MismatchMsg' can be +-- extracted from 'CannotUnifyVariable' and 'Mismatch' constructors. +_MismatchMessage :: Traversal' TcSolverReportMsg MismatchMsg +_MismatchMessage focus (Mismatch msg t a c) = (\msg' -> Mismatch msg' t a c) <$> focus msg +_MismatchMessage focus (CannotUnifyVariable msg a) = flip CannotUnifyVariable a <$> focus msg +_MismatchMessage _ report = pure report + +-- | Focus 'teq_mismatch_expected' from 'TypeEqMismatch'. +_TypeEqMismatchExpected :: Traversal' MismatchMsg Type +#if MIN_VERSION_ghc(9,10,2) +_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ expected _ _ _) = + (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected +#else +_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ _ expected _ _ _) = + (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected +#endif +_TypeEqMismatchExpected _ mismatch = pure mismatch + +-- | Focus 'teq_mismatch_actual' from 'TypeEqMismatch'. +_TypeEqMismatchActual :: Traversal' MismatchMsg Type +#if MIN_VERSION_ghc(9,10,2) +_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ actual _ _) = + (\actual' -> mismatch { teq_mismatch_actual = actual' }) <$> focus actual +#else +_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ _ actual _ _) = + (\actual' -> mismatch { teq_mismatch_expected = actual' }) <$> focus actual +#endif +_TypeEqMismatchActual _ mismatch = pure mismatch diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index 0a16f676e7..39cf9e0d45 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -23,7 +23,7 @@ import GHC.Iface.Errors.Types (IfaceMessage) writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,11,0) writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) (Iface.flagsToIfCompression $ hsc_dflags env) fp iface -#elif MIN_VERSION_ghc(9,3,0) +#else writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 32ec11da4c..c3cc5247d0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -28,10 +28,8 @@ type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> S logActionCompat :: LogActionCompat -> LogAction #if MIN_VERSION_ghc(9,7,0) logActionCompat logAction logFlags (MCDiagnostic severity (ResolvedDiagnosticReason wr) _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify -#elif MIN_VERSION_ghc(9,5,0) -logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify #else -logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify #endif logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index d1053ebffc..ccec23c9c3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -16,14 +16,12 @@ module Development.IDE.GHC.Compat.Outputable ( -- * Parser errors PsWarning, PsError, -#if MIN_VERSION_ghc(9,5,0) defaultDiagnosticOpts, GhcMessage, DriverMessage, Messages, initDiagOpts, pprMessages, -#endif DiagnosticReason(..), renderDiagnosticMessageWithHints, pprMsgEnvelopeBagWithLoc, @@ -51,6 +49,7 @@ module Development.IDE.GHC.Compat.Outputable ( import Data.Maybe import GHC.Driver.Config.Diagnostic import GHC.Driver.Env +import GHC.Driver.Errors.Types (DriverMessage, GhcMessage) import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Parser.Errors.Types @@ -66,17 +65,11 @@ import GHC.Utils.Panic -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0) -import GHC.Driver.Errors.Types (DriverMessage, GhcMessage) -#endif - #if MIN_VERSION_ghc(9,7,0) import GHC.Types.Error (defaultDiagnosticOpts) #endif -#if MIN_VERSION_ghc(9,5,0) type PrintUnqualified = NamePprCtx -#endif -- | A compatible function to print `Outputable` instances -- without unique symbols. @@ -118,33 +111,19 @@ pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e -#if MIN_VERSION_ghc(9,5,0) type ErrMsg = MsgEnvelope GhcMessage type WarnMsg = MsgEnvelope GhcMessage -#else -type ErrMsg = MsgEnvelope DecoratedSDoc -type WarnMsg = MsgEnvelope DecoratedSDoc -#endif mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified -#if MIN_VERSION_ghc(9,5,0) mkPrintUnqualifiedDefault env = mkNamePprCtx ptc (hsc_unit_env env) where ptc = initPromotionTickContext (hsc_dflags env) -#else -mkPrintUnqualifiedDefault env = - -- GHC 9.2 version - -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified - mkPrintUnqualified (hsc_unit_env env) -#endif renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc (diagnosticMessage -#if MIN_VERSION_ghc(9,5,0) (defaultDiagnosticOpts @a) -#endif a) (mkDecorated $ map ppr $ diagnosticHints a) mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 7ae9c2bab9..8e2967ed30 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -49,11 +49,7 @@ initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState initParserState = Lexer.initParserState -#if MIN_VERSION_ghc(9,5,0) pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> GHC.HsParsedModule -#else -pattern HsParsedModule :: Located HsModule -> [FilePath] -> GHC.HsParsedModule -#endif pattern HsParsedModule { hpm_module , hpm_src_files diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 015c5e3aff..99b7328770 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -10,7 +10,7 @@ module Development.IDE.GHC.CoreFile , readBinCoreFile , writeBinCoreFile , getImplicitBinds - , occNamePrefixes) where + ) where import Control.Monad import Control.Monad.IO.Class @@ -18,7 +18,6 @@ import Data.Foldable import Data.IORef import Data.List (isPrefixOf) import Data.Maybe -import qualified Data.Text as T import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Core @@ -118,21 +117,8 @@ codeGutsToCoreFile :: Fingerprint -- ^ Hash of the interface this was generated from -> CgGuts -> CoreFile -#if MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, implicit binds are tidied and part of core binds codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) cg_binds) hash -#else -codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ filter isNotImplictBind cg_binds) hash - --- | Implicit binds can be generated from the interface and are not tidied, --- so we must filter them out -isNotImplictBind :: CoreBind -> Bool -isNotImplictBind bind = not . all isImplicitId $ bindBindings bind - -bindBindings :: CoreBind -> [Var] -bindBindings (NonRec b _) = [b] -bindBindings (Rec bnds) = map fst bnds -#endif getImplicitBinds :: TyCon -> [CoreBind] getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc @@ -223,44 +209,3 @@ tc_iface_bindings (TopIfaceRec vs) = do vs' <- traverse (\(v, e) -> (v,) <$> tcIfaceExpr e) vs pure $ Rec vs' --- | Prefixes that can occur in a GHC OccName -occNamePrefixes :: [T.Text] -occNamePrefixes = - [ - -- long ones - "$con2tag_" - , "$tag2con_" - , "$maxtag_" - - -- four chars - , "$sel:" - , "$tc'" - - -- three chars - , "$dm" - , "$co" - , "$tc" - , "$cp" - , "$fx" - - -- two chars - , "$W" - , "$w" - , "$m" - , "$b" - , "$c" - , "$d" - , "$i" - , "$s" - , "$f" - , "$r" - , "C:" - , "N:" - , "D:" - , "$p" - , "$L" - , "$f" - , "$t" - , "$c" - , "$m" - ] diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 8f919a3bf2..048987f8ae 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -78,15 +78,9 @@ diagFromErrMsg diagSource dflags origErr = -- The function signature changes based on the GHC version. -- While this is not desirable, it avoids more CPP statements in code -- that implements actual logic. -#if MIN_VERSION_ghc(9,5,0) diagFromGhcErrorMessages :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope GhcMessage) -> [FileDiagnostic] diagFromGhcErrorMessages sourceParser dflags errs = diagFromErrMsgs sourceParser dflags errs -#else -diagFromGhcErrorMessages :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope Compat.DecoratedSDoc) -> [FileDiagnostic] -diagFromGhcErrorMessages sourceParser dflags errs = - diagFromSDocErrMsgs sourceParser dflags errs -#endif diagFromErrMsgs :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope GhcMessage) -> [FileDiagnostic] diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . Compat.bagToList diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 4e832f9ee2..068ca6a78a 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -7,9 +7,7 @@ -- | Orphan instances for GHC. -- Note that the 'NFData' instances may not be law abiding. module Development.IDE.GHC.Orphans() where -import Development.IDE.GHC.Compat hiding - (DuplicateRecordFields, - FieldSelectors) +import Development.IDE.GHC.Compat import Development.IDE.GHC.Util import Control.DeepSeq @@ -24,19 +22,16 @@ import GHC.ByteCode.Types import GHC.Data.Bag import GHC.Data.FastString import qualified GHC.Data.StringBuffer as SB +import GHC.Iface.Ext.Types import GHC.Parser.Annotation -import GHC.Types.FieldLabel (DuplicateRecordFields (DuplicateRecordFields, NoDuplicateRecordFields), - FieldSelectors (FieldSelectors, NoFieldSelectors)) import GHC.Types.PkgQual import GHC.Types.SrcLoc -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0) import GHC.Unit.Home.ModInfo import GHC.Unit.Module.Location (ModLocation (..)) import GHC.Unit.Module.WholeCoreBindings -#endif -- Orphan instance for Shake.hs -- https://hub.darcs.net/ross/transformers/issue/86 @@ -68,13 +63,10 @@ instance NFData Unlinked where rnf (DotA f) = rnf f rnf (DotDLL f) = rnf f rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b -#if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb rnf (LoadedBCOs us) = rnf us #endif -#endif -#if MIN_VERSION_ghc(9,5,0) instance NFData WholeCoreBindings where #if MIN_VERSION_ghc(9,11,0) rnf (WholeCoreBindings bs m ml f) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf f @@ -88,7 +80,6 @@ instance NFData ModLocation where #else rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 #endif -#endif instance Show PackageFlag where show = unpack . printOutputable instance Show InteractiveImport where show = unpack . printOutputable @@ -103,12 +94,6 @@ instance NFData SB.StringBuffer where rnf = rwhnf instance Show Module where show = moduleNameString . moduleName - -#if !MIN_VERSION_ghc(9,5,0) -instance (NFData l, NFData e) => NFData (GenLocated l e) where - rnf (L l e) = rnf l `seq` rnf e -#endif - instance Show ModSummary where show = show . ms_mod @@ -191,11 +176,6 @@ instance NFData Type where instance Show a => Show (Bag a) where show = show . bagToList -#if !MIN_VERSION_ghc(9,5,0) -instance NFData HsDocString where - rnf = rwhnf -#endif - instance Show ModGuts where show _ = "modguts" instance NFData ModGuts where @@ -204,11 +184,7 @@ instance NFData ModGuts where instance NFData (ImportDecl GhcPs) where rnf = rwhnf -#if MIN_VERSION_ghc(9,5,0) instance (NFData (HsModule a)) where -#else -instance (NFData HsModule) where -#endif rnf = rwhnf instance Show OccName where show = unpack . printOutputable @@ -239,10 +215,8 @@ instance NFData UnitId where instance NFData NodeKey where rnf = rwhnf -#if MIN_VERSION_ghc(9,5,0) instance NFData HomeModLinkable where rnf = rwhnf -#endif instance NFData (HsExpr (GhcPass Renamed)) where rnf = rwhnf @@ -261,16 +235,3 @@ instance NFData Extension where instance NFData (UniqFM Name [Name]) where rnf (ufmToIntMap -> m) = rnf m - -#if !MIN_VERSION_ghc(9,5,0) -instance NFData DuplicateRecordFields where - rnf DuplicateRecordFields = () - rnf NoDuplicateRecordFields = () - -instance NFData FieldSelectors where - rnf FieldSelectors = () - rnf NoFieldSelectors = () - -instance NFData FieldLabel where - rnf (FieldLabel a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d -#endif diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index a6e0c10461..fb051bda5a 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -27,7 +27,8 @@ module Development.IDE.GHC.Util( dontWriteHieFiles, disableWarningsAsErrors, printOutputable, - getExtensions + getExtensions, + stripOccNamePrefix, ) where import Control.Concurrent @@ -62,6 +63,7 @@ import GHC.IO.Handle.Types import Ide.PluginUtils (unescape) import System.FilePath +import Data.Monoid (First (..)) import GHC.Data.EnumSet import GHC.Data.FastString import GHC.Data.StringBuffer @@ -271,3 +273,55 @@ printOutputable = getExtensions :: ParsedModule -> [Extension] getExtensions = toList . extensionFlags . ms_hspp_opts . pm_mod_summary + +-- | When e.g. DuplicateRecordFields is enabled, compiler generates +-- names like "$sel:accessor:One" and "$sel:accessor:Two" to +-- disambiguate record selectors +-- https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation +stripOccNamePrefix :: T.Text -> T.Text +stripOccNamePrefix name = T.takeWhile (/=':') $ fromMaybe name $ + getFirst $ foldMap (First . (`T.stripPrefix` name)) + occNamePrefixes + +-- | Prefixes that can occur in a GHC OccName +occNamePrefixes :: [T.Text] +occNamePrefixes = + [ + -- long ones + "$con2tag_" + , "$tag2con_" + , "$maxtag_" + + -- four chars + , "$sel:" + , "$tc'" + + -- three chars + , "$dm" + , "$co" + , "$tc" + , "$cp" + , "$fx" + + -- two chars + , "$W" + , "$w" + , "$m" + , "$b" + , "$c" + , "$d" + , "$i" + , "$s" + , "$f" + , "$r" + , "C:" + , "N:" + , "D:" + , "$p" + , "$L" + , "$f" + , "$t" + , "$c" + , "$m" + ] + diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index d6e0f5614c..471cf52eab 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -29,6 +29,7 @@ module Development.IDE.Import.DependencyInformation , lookupModuleFile , BootIdMap , insertBootId + , lookupFingerprint ) where import Control.DeepSeq @@ -49,6 +50,8 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe import Data.Tuple.Extra hiding (first, second) import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util (Fingerprint) +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Orphans () import Development.IDE.Import.FindImports (ArtifactsLocation (..)) import Development.IDE.Types.Diagnostics @@ -136,23 +139,35 @@ data RawDependencyInformation = RawDependencyInformation data DependencyInformation = DependencyInformation - { depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError)) + { depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError)) -- ^ Nodes that cannot be processed correctly. - , depModules :: !(FilePathIdMap ShowableModule) - , depModuleDeps :: !(FilePathIdMap FilePathIdSet) + , depModules :: !(FilePathIdMap ShowableModule) + , depModuleDeps :: !(FilePathIdMap FilePathIdSet) -- ^ For a non-error node, this contains the set of module immediate dependencies -- in the same package. - , depReverseModuleDeps :: !(IntMap IntSet) + , depReverseModuleDeps :: !(IntMap IntSet) -- ^ Contains a reverse mapping from a module to all those that immediately depend on it. - , depPathIdMap :: !PathIdMap + , depPathIdMap :: !PathIdMap -- ^ Map from FilePath to FilePathId - , depBootMap :: !BootIdMap + , depBootMap :: !BootIdMap -- ^ Map from hs-boot file to the corresponding hs file - , depModuleFiles :: !(ShowableModuleEnv FilePathId) + , depModuleFiles :: !(ShowableModuleEnv FilePathId) -- ^ Map from Module to the corresponding non-boot hs file - , depModuleGraph :: !ModuleGraph + , depModuleGraph :: !ModuleGraph + , depTransDepsFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from Module to fingerprint of the transitive dependencies of the module. + , depTransReverseDepsFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from FilePathId to the fingerprint of the transitive reverse dependencies of the module. + , depImmediateReverseDepsFingerprints :: !(FilePathIdMap Fingerprint) + -- ^ Map from FilePathId to the fingerprint of the immediate reverse dependencies of the module. } deriving (Show, Generic) +lookupFingerprint :: NormalizedFilePath -> DependencyInformation -> FilePathIdMap Fingerprint -> Maybe Fingerprint +lookupFingerprint fileId DependencyInformation {..} depFingerprintMap = + do + FilePathId cur_id <- lookupPathToId depPathIdMap fileId + IntMap.lookup cur_id depFingerprintMap + newtype ShowableModule = ShowableModule {showableModule :: Module} deriving NFData @@ -228,8 +243,8 @@ instance Semigroup NodeResult where SuccessNode _ <> ErrorNode errs = ErrorNode errs SuccessNode a <> SuccessNode _ = SuccessNode a -processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> DependencyInformation -processDependencyInformation RawDependencyInformation{..} rawBootMap mg = +processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> FilePathIdMap Fingerprint -> DependencyInformation +processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowFingerMap = DependencyInformation { depErrorNodes = IntMap.fromList errorNodes , depModuleDeps = moduleDeps @@ -239,6 +254,9 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg = , depBootMap = rawBootMap , depModuleFiles = ShowableModuleEnv reverseModuleMap , depModuleGraph = mg + , depTransDepsFingerprints = buildTransDepsFingerprintMap moduleDeps shallowFingerMap + , depTransReverseDepsFingerprints = buildTransDepsFingerprintMap reverseModuleDeps shallowFingerMap + , depImmediateReverseDepsFingerprints = buildImmediateDepsFingerprintMap reverseModuleDeps shallowFingerMap } where resultGraph = buildResultGraph rawImports (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph @@ -398,3 +416,44 @@ instance NFData NamedModuleDep where instance Show NamedModuleDep where show NamedModuleDep{..} = show nmdFilePath + + +buildImmediateDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint +buildImmediateDepsFingerprintMap modulesDeps shallowFingers = + IntMap.fromList + $ map + ( \k -> + ( k, + Util.fingerprintFingerprints $ + map + (shallowFingers IntMap.!) + (k : IntSet.toList (IntMap.findWithDefault IntSet.empty k modulesDeps)) + ) + ) + $ IntMap.keys shallowFingers + +-- | Build a map from file path to its full fingerprint. +-- The fingerprint is depend on both the fingerprints of the file and all its dependencies. +-- This is used to determine if a file has changed and needs to be reloaded. +buildTransDepsFingerprintMap :: FilePathIdMap FilePathIdSet -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint +buildTransDepsFingerprintMap modulesDeps shallowFingers = go keys IntMap.empty + where + keys = IntMap.keys shallowFingers + go :: [IntSet.Key] -> FilePathIdMap Fingerprint -> FilePathIdMap Fingerprint + go keys acc = + case keys of + [] -> acc + k : ks -> + if IntMap.member k acc + -- already in the map, so we can skip + then go ks acc + -- not in the map, so we need to add it + else + let -- get the dependencies of the current key + deps = IntSet.toList $ IntMap.findWithDefault IntSet.empty k modulesDeps + -- add fingerprints of the dependencies to the accumulator + depFingerprints = go deps acc + -- combine the fingerprints of the dependencies with the current key + combinedFingerprints = Util.fingerprintFingerprints $ shallowFingers IntMap.! k : map (depFingerprints IntMap.!) deps + in -- add the combined fingerprints to the accumulator + go ks (IntMap.insert k combinedFingerprints depFingerprints) diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 79614f1809..7c4046a63a 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -145,9 +145,8 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do dflags = hsc_dflags env import_paths = mapMaybe (mkImportDirs env) comp_info other_imports = -#if MIN_VERSION_ghc(9,4,0) - -- On 9.4+ instead of bringing all the units into scope, only bring into scope the units - -- this one depends on + -- Instead of bringing all the units into scope, only bring into scope the units + -- this one depends on. -- This way if you have multiple units with the same module names, we won't get confused -- For example if unit a imports module M from unit B, when there is also a module M in unit C, -- and unit a only depends on unit b, without this logic there is the potential to get confused @@ -163,17 +162,6 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do units = homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId_ dflags) ue hpt_deps :: [UnitId] hpt_deps = homeUnitDepends units -#else - _import_paths' -#endif - - -- first try to find the module as a file. If we can't find it try to find it in the package - -- database. - -- Here the importPaths for the current modules are added to the front of the import paths from the other components. - -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in - -- each component will end up being found in the wrong place and cause a multi-cradle match failure. - _import_paths' = -- import_paths' is only used in GHC < 9.4 - import_paths toModLocation uid file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index cf7845ce08..918e024a4f 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -11,6 +11,7 @@ module Development.IDE.LSP.LanguageServer , Log(..) , ThreadQueue , runWithWorkerThreads + , Setup (..) ) where import Control.Concurrent.STM @@ -81,6 +82,17 @@ instance Pretty Log where LogLspServer msg -> pretty msg LogServerShutdownMessage -> "Received shutdown message" +data Setup config m a + = MkSetup + { doInitialize :: LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a)) + -- ^ the callback invoked when the language server receives the 'Method_Initialize' request + , staticHandlers :: LSP.Handlers m + -- ^ the statically known handlers of the lsp server + , interpretHandler :: (LanguageContextEnv config, a) -> m <~> IO + -- ^ how to interpret @m@ to 'IO' and how to lift 'IO' into @m@ + , onExit :: [IO ()] + -- ^ a list of 'IO' actions that clean up resources and must be run when the server shuts down + } runLanguageServer :: forall config a m. (Show config) @@ -90,18 +102,16 @@ runLanguageServer -> Handle -- output -> config -> (config -> Value -> Either T.Text config) - -> (config -> m config ()) - -> (MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a)), - LSP.Handlers (m config), - (LanguageContextEnv config, a) -> m config <~> IO)) + -> (config -> m ()) + -> (MVar () -> IO (Setup config m a)) -> IO () runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigChange setup = do -- This MVar becomes full when the server thread exits or we receive exit message from client. -- LSP server will be canceled when it's full. clientMsgVar <- newEmptyMVar - (doInitialize, staticHandlers, interpretHandler) <- setup clientMsgVar + MkSetup + { doInitialize, staticHandlers, interpretHandler, onExit } <- setup clientMsgVar let serverDefinition = LSP.ServerDefinition { LSP.parseConfig = parseConfig @@ -115,28 +125,29 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh , LSP.options = modifyOptions options } - let lspCologAction :: MonadIO m2 => Colog.LogAction m2 (Colog.WithSeverity LspServerLog) + let lspCologAction :: forall io. MonadIO io => Colog.LogAction io (Colog.WithSeverity LspServerLog) lspCologAction = toCologActionWithPrio (cmapWithPrio LogLspServer recorder) - void $ untilMVar clientMsgVar $ - void $ LSP.runServerWithHandles + let runServer = + LSP.runServerWithHandles lspCologAction lspCologAction inH outH serverDefinition + untilMVar clientMsgVar $ + runServer `finally` sequence_ onExit + setupLSP :: - forall config err. + forall config. Recorder (WithPriority Log) -> FilePath -- ^ root directory, see Note [Root Directory] -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState) -> MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), - LSP.Handlers (ServerM config), - (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) + -> IO (Setup config (ServerM config) IdeState) setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar = do -- Send everything over a channel, since you need to wait until after initialise before -- LspFuncs is available @@ -171,7 +182,7 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar cancelled <- readTVar cancelledRequests unless (reqId `Set.member` cancelled) retry - let asyncHandlers = mconcat + let staticHandlers = mconcat [ userHandlers , cancelHandler cancelRequest , exitHandler exit @@ -184,7 +195,9 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar let interpretHandler (env, st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO - pure (doInitialize, asyncHandlers, interpretHandler) + let onExit = [stopReactorLoop, exit] + + pure MkSetup {doInitialize, staticHandlers, interpretHandler, onExit} handleInit @@ -266,10 +279,12 @@ runWithWorkerThreads recorder dbLoc f = evalContT $ do liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue) -- | Runs the action until it ends or until the given MVar is put. +-- It is important, that the thread that puts the 'MVar' is not dropped before it puts the 'MVar' i.e. it should +-- occur as the final action in a 'finally' or 'bracket', because otherwise this thread will finish early (as soon +-- as the thread receives the BlockedIndefinitelyOnMVar exception) -- Rethrows any exceptions. -untilMVar :: MonadUnliftIO m => MVar () -> m () -> m () -untilMVar mvar io = void $ - waitAnyCancel =<< traverse async [ io , readMVar mvar ] +untilMVar :: MonadUnliftIO m => MVar () -> m a -> m () +untilMVar mvar io = race_ (readMVar mvar) io cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c) cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \TNotificationMessage{_params=CancelParams{_id}} -> diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 62b71c3ab6..ad4a36327a 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -12,11 +12,9 @@ module Development.IDE.Main ) where import Control.Concurrent.Extra (withNumCapabilities) -import Control.Concurrent.MVar (newEmptyMVar, +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, tryReadMVar) import Control.Concurrent.STM.Stats (dumpSTMStats) -import Control.Exception.Safe (SomeException, - displayException) import Control.Monad.Extra (concatMapM, unless, when) import Control.Monad.IO.Class (liftIO) @@ -320,9 +318,8 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re ioT <- offsetTime logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) - ideStateVar <- newEmptyMVar - let getIdeState :: LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState - getIdeState env rootPath withHieDb threadQueue = do + let getIdeState :: MVar IdeState -> LSP.LanguageContextEnv Config -> FilePath -> WithHieDb -> Shake.ThreadQueue -> IO IdeState + getIdeState ideStateVar env rootPath withHieDb threadQueue = do t <- ioT logWith recorder Info $ LogLspStartDuration t sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions rootPath (tLoaderQueue threadQueue) @@ -355,9 +352,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putMVar ideStateVar ide pure ide - let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) getIdeState + let setup ideStateVar = setupLSP (cmapWithPrio LogLanguageServer recorder) argsProjectRoot argsGetHieDbLoc (pluginHandlers plugins) (getIdeState ideStateVar) -- See Note [Client configuration in Rules] - onConfigChange cfg = do + onConfigChange ideStateVar cfg = do -- TODO: this is nuts, we're converting back to JSON just to get a fingerprint let cfgObj = J.toJSON cfg mide <- liftIO $ tryReadMVar ideStateVar @@ -370,7 +367,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re modifyClientSettings ide (const $ Just cfgObj) return [toNoFileKey Rules.GetClientSettings] - runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup + do + ideStateVar <- newEmptyMVar + runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig (onConfigChange ideStateVar) (setup ideStateVar) dumpSTMStats Check argFiles -> do let dir = argsProjectRoot diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 0564855177..d92bf1da85 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -114,15 +114,10 @@ produceCompletions recorder = do -- Drop any explicit imports in ImportDecl if not hidden dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs dropListFromImportDecl iDecl = let -#if MIN_VERSION_ghc(9,5,0) f d@ImportDecl {ideclImportList} = case ideclImportList of Just (Exactly, _) -> d {ideclImportList=Nothing} -#else - f d@ImportDecl {ideclHiding} = case ideclHiding of - Just (False, _) -> d {ideclHiding=Nothing} -#endif -- if hiding or Nothing just return d - _ -> d + _ -> d f x = x in f <$> iDecl diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 9fdc196cd5..0a5cecaca8 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -37,24 +37,26 @@ import Data.Aeson (ToJSON (toJSON)) import Data.Function (on) import qualified Data.HashSet as HashSet -import Data.Monoid (First (..)) import Data.Ord (Down (Down)) import qualified Data.Set as Set import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat hiding (isQual, ppr) import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.CoreFile (occNamePrefixes) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports import Development.IDE.Types.Options +import GHC.Iface.Ext.Types (HieAST, + NodeInfo (..)) +import GHC.Iface.Ext.Utils (nodeInfo) import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), IdePlugins (..), PluginId) +import Language.Haskell.Syntax.Basic import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS @@ -74,9 +76,6 @@ import GHC.Plugins (Depth (AllTheWay), -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0) -import Language.Haskell.Syntax.Basic -#endif -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -138,42 +137,23 @@ getCContext pos pm | pos `isInsideSrcSpan` r = Just TypeContext goInline _ = Nothing -#if MIN_VERSION_ghc(9,5,0) importGo :: GHC.LImportDecl GhcPs -> Maybe Context importGo (L (locA -> r) impDecl) | pos `isInsideSrcSpan` r = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl) -#else - importGo :: GHC.LImportDecl GhcPs -> Maybe Context - importGo (L (locA -> r) impDecl) - | pos `isInsideSrcSpan` r - = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl) -#endif <|> Just (ImportContext importModuleName) | otherwise = Nothing where importModuleName = moduleNameString $ unLoc $ ideclName impDecl -- importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context -#if MIN_VERSION_ghc(9,5,0) importInline modName (Just (EverythingBut, L r _)) | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName | otherwise = Nothing -#else - importInline modName (Just (True, L r _)) - | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName - | otherwise = Nothing -#endif -#if MIN_VERSION_ghc(9,5,0) importInline modName (Just (Exactly, L r _)) | pos `isInsideSrcSpan` r = Just $ ImportListContext modName | otherwise = Nothing -#else - importInline modName (Just (False, L r _)) - | pos `isInsideSrcSpan` r = Just $ ImportListContext modName - | otherwise = Nothing -#endif importInline _ _ = Nothing @@ -261,7 +241,7 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..} compKind = occNameToComKind origName isTypeCompl = isTcOcc origName typeText = Nothing - label = stripPrefix $ printOutputable origName + label = stripOccNamePrefix $ printOutputable origName insertText = case isInfix of Nothing -> label Just LeftSide -> label <> "`" @@ -801,17 +781,6 @@ openingBacktick line prefixModule prefixText Position { _character=(fromIntegral -- --------------------------------------------------------------------- --- | Under certain circumstance GHC generates some extra stuff that we --- don't want in the autocompleted symbols - {- When e.g. DuplicateRecordFields is enabled, compiler generates - names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors - https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation - -} --- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace. -stripPrefix :: T.Text -> T.Text -stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $ - getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes - mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r where @@ -912,7 +881,9 @@ getCompletionPrefixFromRope pos@(Position l c) ropetext = [] -> Nothing (x:xs) -> do let modParts = reverse $ filter (not .T.null) xs - modName = T.intercalate "." modParts + -- Must check the prefix is a valid module name, else record dot accesses treat + -- the record name as a qualName for search and generated imports + modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else "" return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } completionPrefixPos :: PosPrefixInfo -> Position diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 40ce1dda7b..c596d1fb82 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -16,7 +16,7 @@ module Development.IDE.Plugin.TypeLenses ( import Control.Concurrent.STM.Stats (atomically) import Control.DeepSeq (rwhnf) -import Control.Lens ((?~)) +import Control.Lens (to, (?~), (^?)) import Control.Monad (mzero) import Control.Monad.Extra (whenMaybe) import Control.Monad.IO.Class (MonadIO (liftIO)) @@ -25,13 +25,17 @@ import Data.Aeson.Types (toJSON) import qualified Data.Aeson.Types as A import Data.List (find) import qualified Data.Map as Map -import Data.Maybe (catMaybes, maybeToList) +import Data.Maybe (catMaybes, isJust, + maybeToList) import qualified Data.Text as T import Development.IDE (FileDiagnostic (..), GhcSession (..), HscEnvEq (hscEnv), RuleResult, Rules, Uri, - define, srcSpanToRange, + _SomeStructuredMessage, + define, + fdStructuredMessageL, + srcSpanToRange, usePropertyAction) import Development.IDE.Core.Compile (TcModuleResult (..)) import Development.IDE.Core.PluginUtils @@ -45,6 +49,10 @@ import Development.IDE.Core.Shake (getHiddenDiagnostics, use) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Error (_TcRnMessage, + _TcRnMissingSignature, + msgEnvelopeErrorL, + stripTcRnMessageContext) import Development.IDE.GHC.Util (printName) import Development.IDE.Graph.Classes import Development.IDE.Types.Location (Position (Position, _line), @@ -129,9 +137,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif -- dummy type to make sure HLS resolves our lens [ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve) | diag <- diags - , let lspDiag@Diagnostic {_range} = fdLspDiagnostic diag + , let Diagnostic {_range} = fdLspDiagnostic diag , fdFilePath diag == nfp - , isGlobalDiagnostic lspDiag] + , isGlobalDiagnostic diag] -- The second option is to generate lenses from the GlobalBindingTypeSig -- rule. This is the only type that needs to have the range adjusted -- with PositionMapping. @@ -200,7 +208,7 @@ commandHandler _ideState _ wedit = do pure $ InR Null -------------------------------------------------------------------------------- -suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, TextEdit)] +suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> [(T.Text, TextEdit)] suggestSignature isQuickFix mGblSigs diag = maybeToList (suggestGlobalSignature isQuickFix mGblSigs diag) @@ -208,14 +216,19 @@ suggestSignature isQuickFix mGblSigs diag = -- works with a diagnostic, which then calls the secondary function with -- whatever pieces of the diagnostic it needs. This allows the resolve function, -- which no longer has the Diagnostic, to still call the secondary functions. -suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> Maybe (T.Text, TextEdit) -suggestGlobalSignature isQuickFix mGblSigs diag@Diagnostic{_range} +suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> Maybe (T.Text, TextEdit) +suggestGlobalSignature isQuickFix mGblSigs diag@FileDiagnostic {fdLspDiagnostic = Diagnostic {_range}} | isGlobalDiagnostic diag = suggestGlobalSignature' isQuickFix mGblSigs Nothing _range | otherwise = Nothing -isGlobalDiagnostic :: Diagnostic -> Bool -isGlobalDiagnostic Diagnostic{_message} = _message =~ ("(Top-level binding|Pattern synonym) with no type signature" :: T.Text) +isGlobalDiagnostic :: FileDiagnostic -> Bool +isGlobalDiagnostic diag = diag ^? fdStructuredMessageL + . _SomeStructuredMessage + . msgEnvelopeErrorL + . _TcRnMessage + . _TcRnMissingSignature + & isJust -- If a PositionMapping is supplied, this function will call -- gblBindingTypeSigToEdit with it to create a TextEdit in the right location. diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index a577cae32e..50df0f5ba5 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -67,6 +67,23 @@ import Data.Tree import qualified Data.Tree as T import Data.Version (showVersion) import Development.IDE.Types.Shake (WithHieDb) +import GHC.Iface.Ext.Types (EvVarSource (..), + HieAST (..), + HieASTs (..), + HieArgs (..), + HieType (..), Identifier, + IdentifierDetails (..), + NodeInfo (..), Scope, + Span) +import GHC.Iface.Ext.Utils (EvidenceInfo (..), + RefMap, getEvidenceTree, + getScopeFromContext, + hieTypeToIface, + isEvidenceContext, + isEvidenceUse, + isOccurrence, nodeInfo, + recoverFullType, + selectSmallestContaining) import HieDb hiding (pointCommand, withHieDb) import System.Directory (doesFileExist) @@ -113,7 +130,7 @@ foiReferencesAtPoint file pos (FOIReferences asts) = getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name] getNamesAtPoint hf pos mapping = - concat $ pointCommand hf posFile (rights . M.keys . getNodeIds) + concat $ pointCommand hf posFile (rights . M.keys . getSourceNodeIds) where posFile = fromMaybe pos $ fromCurrentPosition mapping pos @@ -488,7 +505,7 @@ instanceLocationsAtPoint instanceLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _rm _ _) = let ns = concat $ pointCommand ast pos (M.keys . getNodeIds) evTrees = mapMaybe (eitherToMaybe >=> getEvidenceTree _rm) ns - evNs = concatMap (map (evidenceVar) . T.flatten) evTrees + evNs = concatMap (map evidenceVar . T.flatten) evTrees in fmap (nubOrd . concat) $ mapMaybeM (nameToLocation withHieDb lookupModule) evNs diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index ee8a8c18bc..996e55ef1a 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -38,11 +38,7 @@ type DocMap = NameEnv SpanDoc type TyThingMap = NameEnv TyThing -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. -#if MIN_VERSION_ghc(9,5,0) unqualIEWrapName :: IEWrappedName GhcPs -> T.Text -#else -unqualIEWrapName :: IEWrappedName RdrName -> T.Text -#endif unqualIEWrapName = printOutputable . rdrNameOcc . ieWrappedName -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -194,11 +190,10 @@ haddockToMarkdown (H.DocOrderedList things) = haddockToMarkdown (H.DocDefList things) = '\n' : (unlines $ map (\(term, defn) -> "+ **" ++ haddockToMarkdown term ++ "**: " ++ haddockToMarkdown defn) things) --- we cannot render math by default -haddockToMarkdown (H.DocMathInline _) - = "*cannot render inline math formula*" -haddockToMarkdown (H.DocMathDisplay _) - = "\n\n*cannot render display math formula*\n\n" +haddockToMarkdown (H.DocMathInline s) + = "`" ++ s ++ "`" +haddockToMarkdown (H.DocMathDisplay s) + = "\n```latex\n" ++ s ++ "\n```\n" -- TODO: render tables haddockToMarkdown (H.DocTable _t) diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 85f2ef1037..dcf7778de3 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -28,6 +28,7 @@ import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Spans.Common +import GHC.Iface.Ext.Utils (RefMap) import Language.LSP.Protocol.Types (filePathToUri, getUri) import Prelude hiding (mod) import System.Directory diff --git a/ghcide/src/Development/IDE/Spans/LocalBindings.hs b/ghcide/src/Development/IDE/Spans/LocalBindings.hs index 8ca811eaa0..8806ed8ab3 100644 --- a/ghcide/src/Development/IDE/Spans/LocalBindings.hs +++ b/ghcide/src/Development/IDE/Spans/LocalBindings.hs @@ -17,15 +17,16 @@ import qualified Data.IntervalMap.FingerTree as IM import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S +import GHC.Iface.Ext.Types (IdentifierDetails (..), + Scope (..)) +import GHC.Iface.Ext.Utils (RefMap, getBindSiteFromContext, + getScopeFromContext) + import Development.IDE.GHC.Compat (Name, NameEnv, RealSrcSpan, - RefMap, Scope (..), Type, - getBindSiteFromContext, - getScopeFromContext, identInfo, - identType, isSystemName, + Type, isSystemName, nonDetNameEnvElts, realSrcSpanEnd, realSrcSpanStart, unitNameEnv) - import Development.IDE.GHC.Error import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index 89e1f2d12f..5072fa7ffa 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/ghcide/src/Development/IDE/Types/Diagnostics.hs @@ -24,9 +24,7 @@ module Development.IDE.Types.Diagnostics ( ideErrorFromLspDiag, showDiagnostics, showDiagnosticsColored, -#if MIN_VERSION_ghc(9,5,0) showGhcCode, -#endif IdeResultNoDiagnosticsEarlyCutoff, attachReason, attachedReason) where @@ -45,17 +43,11 @@ import Development.IDE.GHC.Compat (GhcMessage, MsgEnvelope, flagSpecName, wWarningFlags) import Development.IDE.Types.Location import GHC.Generics -#if MIN_VERSION_ghc(9,5,0) import GHC.Types.Error (DiagnosticCode (..), DiagnosticReason (..), diagnosticCode, diagnosticReason, errMsgDiagnostic) -#else -import GHC.Types.Error (DiagnosticReason (..), - diagnosticReason, - errMsgDiagnostic) -#endif import Language.LSP.Diagnostics import Language.LSP.Protocol.Lens (data_) import Language.LSP.Protocol.Types as LSP @@ -110,30 +102,25 @@ ideErrorFromLspDiag lspDiag fdFilePath mbOrigMsg = fdLspDiagnostic = lspDiag & attachReason (fmap (diagnosticReason . errMsgDiagnostic) mbOrigMsg) - & setGhcCode mbOrigMsg + & attachDiagnosticCode ((diagnosticCode . errMsgDiagnostic) =<< mbOrigMsg) in FileDiagnostic {..} --- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code which is linked +-- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code, and include the link -- to https://errors.haskell.org/. -setGhcCode :: Maybe (MsgEnvelope GhcMessage) -> LSP.Diagnostic -> LSP.Diagnostic -#if MIN_VERSION_ghc(9,5,0) -setGhcCode mbOrigMsg diag = - let mbGhcCode = do - origMsg <- mbOrigMsg - code <- diagnosticCode (errMsgDiagnostic origMsg) - pure (InR (showGhcCode code)) - in - diag { _code = mbGhcCode <|> _code diag } -#else -setGhcCode _ diag = diag -#endif +attachDiagnosticCode :: Maybe DiagnosticCode -> LSP.Diagnostic -> LSP.Diagnostic +attachDiagnosticCode Nothing diag = diag +attachDiagnosticCode (Just code) diag = + let + textualCode = showGhcCode code + codeDesc = LSP.CodeDescription{ _href = Uri $ "https://errors.haskell.org/messages/" <> textualCode } + in diag { _code = Just (InR textualCode), _codeDescription = Just codeDesc} #if MIN_VERSION_ghc(9,9,0) -- DiagnosticCode only got a show instance in 9.10.1 showGhcCode :: DiagnosticCode -> T.Text showGhcCode = T.pack . show -#elif MIN_VERSION_ghc(9,5,0) +#else showGhcCode :: DiagnosticCode -> T.Text showGhcCode (DiagnosticCode prefix c) = T.pack $ prefix ++ "-" ++ printf "%05d" c #endif diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index be3ea20932..8d4d91e166 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -68,10 +68,12 @@ data IdeOptions = IdeOptions , optCheckParents :: IO CheckParents -- ^ When to typecheck reverse dependencies of a file , optHaddockParse :: OptHaddockParse - -- ^ Whether to return result of parsing module with Opt_Haddock. - -- Otherwise, return the result of parsing without Opt_Haddock, so - -- that the parsed module contains the result of Opt_KeepRawTokenStream, - -- which might be necessary for hlint. + -- ^ Whether to parse modules with '-haddock' by default. + -- If 'HaddockParse' is given, we parse local haskell modules with the + -- '-haddock' flag enables. + -- If a plugin requires the parsed sources *without* '-haddock', it needs + -- to use rules that explicitly disable the '-haddock' flag. + -- See call sites of 'withoutOptHaddock' for rules that parse without '-haddock'. , optModifyDynFlags :: Config -> DynFlagsModifications -- ^ Will be called right after setting up a new cradle, -- allowing to customize the Ghc options used diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 3bfbfa4f53..50d4b869ba 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1,7 +1,7 @@ cabal-version: 3.4 category: Development name: haskell-language-server -version: 2.10.0.0 +version: 2.11.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at @@ -14,7 +14,7 @@ copyright: The Haskell IDE Team license: Apache-2.0 license-file: LICENSE build-type: Simple -tested-with: GHC ==9.10.1 || ==9.8.2 || ==9.6.5 || ==9.4.8 +tested-with: GHC == {9.12.2, 9.10.2, 9.8.4, 9.6.7} extra-source-files: README.md ChangeLog.md @@ -136,8 +136,8 @@ library hls-cabal-fmt-plugin build-depends: , directory , filepath - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp-types , mtl @@ -157,8 +157,8 @@ test-suite hls-cabal-fmt-plugin-tests , filepath , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-fmt-plugin - , hls-plugin-api == 2.10.0.0 - , hls-test-utils == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 + , hls-test-utils == 2.11.0.0 if flag(isolateCabalfmtTests) build-tool-depends: cabal-fmt:cabal-fmt ^>=0.1.12 @@ -193,8 +193,8 @@ library hls-cabal-gild-plugin build-depends: , directory , filepath - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp-types , text , mtl @@ -213,8 +213,8 @@ test-suite hls-cabal-gild-plugin-tests , filepath , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-gild-plugin - , hls-plugin-api == 2.10.0.0 - , hls-test-utils == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 + , hls-test-utils == 2.11.0.0 if flag(isolateCabalGildTests) -- https://github.com/tfausak/cabal-gild/issues/89 @@ -254,8 +254,13 @@ library hls-cabal-plugin Ide.Plugin.Cabal.Completion.Types Ide.Plugin.Cabal.Definition Ide.Plugin.Cabal.FieldSuggest + Ide.Plugin.Cabal.Files + Ide.Plugin.Cabal.OfInterest Ide.Plugin.Cabal.LicenseSuggest - Ide.Plugin.Cabal.CabalAdd + Ide.Plugin.Cabal.Rules + Ide.Plugin.Cabal.CabalAdd.Command + Ide.Plugin.Cabal.CabalAdd.CodeAction + Ide.Plugin.Cabal.CabalAdd.Types Ide.Plugin.Cabal.Orphans Ide.Plugin.Cabal.Outline Ide.Plugin.Cabal.Parse @@ -269,21 +274,21 @@ library hls-cabal-plugin , directory , filepath , extra >=1.7.4 - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hashable - , hls-plugin-api == 2.10.0.0 - , hls-graph == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 + , hls-graph == 2.11.0.0 , lens , lsp ^>=2.7 , lsp-types ^>=2.3 + , mtl , regex-tdfa ^>=1.3.1 , text , text-rope , transformers , unordered-containers >=0.2.10.0 , containers - , cabal-add - , process + , cabal-add ^>=0.2 , aeson , Cabal , pretty @@ -311,11 +316,11 @@ test-suite hls-cabal-plugin-tests , filepath , ghcide , haskell-language-server:hls-cabal-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens + , lsp , lsp-types , text - , hls-plugin-api ----------------------------- -- class plugin @@ -349,9 +354,9 @@ library hls-class-plugin , extra , ghc , ghc-exactprint >= 1.5 && < 1.13.0.0 - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hls-graph - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , mtl @@ -372,7 +377,7 @@ test-suite hls-class-plugin-tests build-depends: , filepath , haskell-language-server:hls-class-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -406,9 +411,10 @@ library hls-call-hierarchy-plugin , aeson , containers , extra - , ghcide == 2.10.0.0 - , hiedb ^>= 0.6.0.2 - , hls-plugin-api == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 + , hiedb ^>= 0.7.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp >=2.7 , sqlite-simple @@ -429,7 +435,7 @@ test-suite hls-call-hierarchy-plugin-tests , extra , filepath , haskell-language-server:hls-call-hierarchy-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp , lsp-test @@ -473,15 +479,15 @@ library hls-eval-plugin , bytestring , containers , deepseq - , Diff ^>=0.5 + , Diff ^>=0.5 || ^>=1.0.0 , dlist , extra , filepath , ghc , ghc-boot-th - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hls-graph - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , lsp-types @@ -512,7 +518,7 @@ test-suite hls-eval-plugin-tests , filepath , haskell-language-server:hls-eval-plugin , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -542,9 +548,9 @@ library hls-explicit-imports-plugin , containers , deepseq , ghc - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hls-graph - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , mtl @@ -565,7 +571,7 @@ test-suite hls-explicit-imports-plugin-tests , extra , filepath , haskell-language-server:hls-explicit-imports-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -592,11 +598,11 @@ library hls-rename-plugin hs-source-dirs: plugins/hls-rename-plugin/src build-depends: , containers - , ghcide == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 , hashable - , hiedb ^>= 0.6.0.2 - , hie-compat - , hls-plugin-api == 2.10.0.0 + , hiedb ^>= 0.7.0.0 + , hls-plugin-api == 2.11.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp-types @@ -621,7 +627,7 @@ test-suite hls-rename-plugin-tests , filepath , hls-plugin-api , haskell-language-server:hls-rename-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -652,9 +658,9 @@ library hls-retrie-plugin , containers , extra , ghc - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hashable - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp @@ -683,7 +689,7 @@ test-suite hls-retrie-plugin-tests , filepath , hls-plugin-api , haskell-language-server:{hls-refactor-plugin, hls-retrie-plugin} - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , text ----------------------------- @@ -703,14 +709,14 @@ flag hlint manual: True common hlint - if flag(hlint) && ((impl(ghc < 9.10) || impl(ghc > 9.11)) || flag(ignore-plugins-ghc-bounds)) + if flag(hlint) build-depends: haskell-language-server:hls-hlint-plugin cpp-options: -Dhls_hlint library hls-hlint-plugin import: defaults, pedantic, warnings -- https://github.com/ndmitchell/hlint/pull/1594 - if !(flag(hlint)) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds)) + if !flag(hlint) buildable: False exposed-modules: Ide.Plugin.Hlint hs-source-dirs: plugins/hls-hlint-plugin/src @@ -720,10 +726,10 @@ library hls-hlint-plugin , containers , deepseq , filepath - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hashable , hlint >= 3.5 && < 3.11 - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , mtl , refact @@ -735,10 +741,14 @@ library hls-hlint-plugin , transformers , unordered-containers , ghc-lib-parser-ex - , apply-refact - -- , lsp-types + -- apply-refact doesn't work on 9.10, or even have a buildable + -- configuration + if impl(ghc >= 9.11) || impl(ghc < 9.10) + cpp-options: -DAPPLY_REFACT + build-depends: apply-refact + if flag(ghc-lib) cpp-options: -DGHC_LIB build-depends: @@ -753,7 +763,7 @@ library hls-hlint-plugin test-suite hls-hlint-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(hlint) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds)) + if !flag(hlint) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-hlint-plugin/test @@ -761,13 +771,14 @@ test-suite hls-hlint-plugin-tests -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/24648 if os(darwin) ghc-options: -optl-Wl,-ld_classic + build-depends: aeson , containers , filepath , haskell-language-server:hls-hlint-plugin , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -795,13 +806,12 @@ library hls-stan-plugin build-depends: , deepseq , hashable - , hie-compat , hls-plugin-api , ghcide , lsp-types , text , unordered-containers - , stan >= 0.1.2.0 + , stan >= 0.2.1.0 , trial , directory @@ -822,7 +832,7 @@ test-suite hls-stan-plugin-tests , filepath , haskell-language-server:hls-stan-plugin , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -853,8 +863,8 @@ library hls-module-name-plugin , aeson , containers , filepath - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp , text , text-rope @@ -871,7 +881,7 @@ test-suite hls-module-name-plugin-tests build-depends: , filepath , haskell-language-server:hls-module-name-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- -- pragmas plugin @@ -897,8 +907,8 @@ library hls-pragmas-plugin , aeson , extra , fuzzy - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lens-aeson , lsp @@ -917,7 +927,7 @@ test-suite hls-pragmas-plugin-tests , aeson , filepath , haskell-language-server:hls-pragmas-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-types , text @@ -950,8 +960,8 @@ library hls-splice-plugin , extra , foldl , ghc - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp @@ -974,7 +984,7 @@ test-suite hls-splice-plugin-tests build-depends: , filepath , haskell-language-server:hls-splice-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , text ----------------------------- @@ -1001,10 +1011,10 @@ library hls-alternate-number-format-plugin build-depends: , containers , extra - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , ghc-boot-th , hls-graph - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp ^>=2.7 , mtl @@ -1029,7 +1039,7 @@ test-suite hls-alternate-number-format-plugin-tests build-depends: , filepath , haskell-language-server:hls-alternate-number-format-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , regex-tdfa , tasty-quickcheck , text @@ -1061,8 +1071,9 @@ library hls-qualify-imported-names-plugin hs-source-dirs: plugins/hls-qualify-imported-names-plugin/src build-depends: , containers - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , text @@ -1084,7 +1095,7 @@ test-suite hls-qualify-imported-names-plugin-tests , text , filepath , haskell-language-server:hls-qualify-imported-names-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- -- code range plugin @@ -1114,9 +1125,10 @@ library hls-code-range-plugin , containers , deepseq , extra - , ghcide == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 , hashable - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , mtl @@ -1138,7 +1150,7 @@ test-suite hls-code-range-plugin-tests , bytestring , filepath , haskell-language-server:hls-code-range-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp , lsp-test @@ -1166,14 +1178,16 @@ library hls-change-type-signature-plugin exposed-modules: Ide.Plugin.ChangeTypeSignature hs-source-dirs: plugins/hls-change-type-signature-plugin/src build-depends: - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 + , lens , lsp-types , regex-tdfa , syb , text , transformers , containers + , ghc default-extensions: DataKinds ExplicitNamespaces @@ -1191,7 +1205,8 @@ test-suite hls-change-type-signature-plugin-tests build-depends: , filepath , haskell-language-server:hls-change-type-signature-plugin - , hls-test-utils == 2.10.0.0 + , hls-plugin-api + , hls-test-utils == 2.11.0.0 , regex-tdfa , text default-extensions: @@ -1224,9 +1239,9 @@ library hls-gadt-plugin , containers , extra , ghc - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , ghc-exactprint - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp >=2.7 @@ -1246,7 +1261,7 @@ test-suite hls-gadt-plugin-tests build-depends: , filepath , haskell-language-server:hls-gadt-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , text ----------------------------- @@ -1273,9 +1288,9 @@ library hls-explicit-fixity-plugin , containers , deepseq , extra - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , hashable - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , lsp >=2.7 , text @@ -1291,7 +1306,7 @@ test-suite hls-explicit-fixity-plugin-tests build-depends: , filepath , haskell-language-server:hls-explicit-fixity-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , text ----------------------------- @@ -1314,8 +1329,9 @@ library hls-explicit-record-fields-plugin buildable: False exposed-modules: Ide.Plugin.ExplicitFields build-depends: - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp , lens , hls-graph @@ -1341,7 +1357,7 @@ test-suite hls-explicit-record-fields-plugin-tests , text , ghcide , haskell-language-server:hls-explicit-record-fields-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- -- overloaded record dot plugin @@ -1387,7 +1403,7 @@ test-suite hls-overloaded-record-dot-plugin-tests , filepath , text , haskell-language-server:hls-overloaded-record-dot-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- @@ -1413,8 +1429,8 @@ library hls-floskell-plugin hs-source-dirs: plugins/hls-floskell-plugin/src build-depends: , floskell ^>=0.11.0 - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp-types ^>=2.3 , mtl , text @@ -1430,7 +1446,7 @@ test-suite hls-floskell-plugin-tests build-depends: , filepath , haskell-language-server:hls-floskell-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- -- fourmolu plugin @@ -1456,8 +1472,8 @@ library hls-fourmolu-plugin , filepath , fourmolu ^>= 0.14 || ^>= 0.15 || ^>= 0.16 || ^>=0.17 || ^>=0.18 , ghc-boot-th - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , mtl @@ -1483,7 +1499,7 @@ test-suite hls-fourmolu-plugin-tests , filepath , haskell-language-server:hls-fourmolu-plugin , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lsp-test ----------------------------- @@ -1510,8 +1526,8 @@ library hls-ormolu-plugin , extra , filepath , ghc-boot-th - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp , mtl , process-extras >= 0.7.1 @@ -1537,7 +1553,7 @@ test-suite hls-ormolu-plugin-tests , filepath , haskell-language-server:hls-ormolu-plugin , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lsp-types , ormolu @@ -1566,8 +1582,8 @@ library hls-stylish-haskell-plugin , directory , filepath , ghc-boot-th - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp-types , mtl , stylish-haskell >=0.12 && <0.16 @@ -1584,7 +1600,7 @@ test-suite hls-stylish-haskell-plugin-tests build-depends: , filepath , haskell-language-server:hls-stylish-haskell-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 ----------------------------- -- refactor plugin @@ -1636,8 +1652,8 @@ library hls-refactor-plugin , bytestring , ghc-boot , regex-tdfa - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lsp , text , text-rope @@ -1675,7 +1691,7 @@ test-suite hls-refactor-plugin-tests , filepath , ghcide:ghcide , haskell-language-server:hls-refactor-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-test , lsp-types @@ -1722,8 +1738,9 @@ library hls-semantic-tokens-plugin , extra , text-rope , mtl >= 2.2 - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghc + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp >=2.6 , text @@ -1733,7 +1750,7 @@ library hls-semantic-tokens-plugin , array , deepseq , dlist - , hls-graph == 2.10.0.0 + , hls-graph == 2.11.0.0 , template-haskell , data-default , stm @@ -1754,10 +1771,10 @@ test-suite hls-semantic-tokens-plugin-tests , containers , data-default , filepath - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , haskell-language-server:hls-semantic-tokens-plugin - , hls-plugin-api == 2.10.0.0 - , hls-test-utils == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp , lsp-test @@ -1787,9 +1804,9 @@ library hls-notes-plugin hs-source-dirs: plugins/hls-notes-plugin/src build-depends: , array - , ghcide == 2.10.0.0 - , hls-graph == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-graph == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp >=2.7 , mtl >= 2.2 @@ -1815,7 +1832,7 @@ test-suite hls-notes-plugin-tests build-depends: , filepath , haskell-language-server:hls-notes-plugin - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 default-extensions: OverloadedStrings ---------------------------- @@ -1875,10 +1892,10 @@ library , extra , filepath , ghc - , ghcide == 2.10.0.0 + , ghcide == 2.11.0.0 , githash >=0.1.6.1 , hie-bios - , hls-plugin-api == 2.10.0.0 + , hls-plugin-api == 2.11.0.0 , optparse-applicative , optparse-simple , prettyprinter >= 1.7 @@ -1981,7 +1998,7 @@ test-suite func-test , ghcide:ghcide , hashable , hls-plugin-api - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , lens , lsp-test , lsp-types @@ -2025,7 +2042,7 @@ test-suite wrapper-test build-depends: , extra - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 , process hs-source-dirs: test/wrapper @@ -2118,7 +2135,7 @@ test-suite ghcide-tests , text , text-rope , unordered-containers - , hls-test-utils == 2.10.0.0 + , hls-test-utils == 2.11.0.0 if impl(ghc <9.3) build-depends: ghc-typelits-knownnat @@ -2265,3 +2282,28 @@ test-suite ghcide-bench-test OverloadedStrings RecordWildCards ViewPatterns + +executable plugin-tutorial + import: defaults + -- The plugin tutorial is only compatible with 9.6 and 9.8. + -- No particular reason, just to avoid excessive CPP. + if (impl(ghc >= 9.6) && impl(ghc < 9.10)) + buildable: True + else + buildable: False + ghc-options: -pgmL markdown-unlit + main-is: docs/contributing/plugin-tutorial.lhs + build-tool-depends: markdown-unlit:markdown-unlit + build-depends: + base, + ghcide, + hls-plugin-api, + aeson, + lsp, + lsp-types, + markdown-unlit, + text, + unordered-containers, + containers, + transformers, + ghc, diff --git a/hie-compat/CHANGELOG.md b/hie-compat/CHANGELOG.md deleted file mode 100644 index 82d590f7ab..0000000000 --- a/hie-compat/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for hie-compat - -## 0.1.0.0 -- 2020-10-19 - -* Initial Release diff --git a/hie-compat/LICENSE b/hie-compat/LICENSE deleted file mode 100644 index 8775cb7967..0000000000 --- a/hie-compat/LICENSE +++ /dev/null @@ -1,201 +0,0 @@ - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright 2019 Zubin Duggal - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/hie-compat/README.md b/hie-compat/README.md deleted file mode 100644 index 7ac08b305a..0000000000 --- a/hie-compat/README.md +++ /dev/null @@ -1,24 +0,0 @@ -# hie-compat - -Mainly a backport of [HIE -Files](https://gitlab.haskell.org/ghc/ghc/-/wikis/hie-files) for ghc 8.8, along -with a few other backports of fixes useful for `ghcide` - -Also includes backport of record-dot-syntax support to 9.2.x - -Fully compatible with `.hie` files natively produced by versions of GHC that support -them. - -**THIS DOES NOT LET YOU READ HIE FILES WITH MISMATCHED VERSIONS OF GHC** - -Backports included: - -https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8589 - -https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4037 - -https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4068 - -https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3199 - -https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2578 diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal deleted file mode 100644 index 2b361df887..0000000000 --- a/hie-compat/hie-compat.cabal +++ /dev/null @@ -1,39 +0,0 @@ -cabal-version: 1.22 -name: hie-compat -version: 0.3.1.2 -synopsis: HIE files for GHC 8.8 and other HIE file backports -license: Apache-2.0 -description: - Backports for HIE files to GHC 8.8, along with a few other backports - of HIE file related fixes for ghcide. - - THIS DOES NOT LET YOU READ HIE FILES WITH MISMATCHED VERSIONS OF GHC -license-file: LICENSE -author: Zubin Duggal -maintainer: zubin.duggal@gmail.com -build-type: Simple -extra-source-files: CHANGELOG.md README.md -category: Development -homepage: https://github.com/haskell/haskell-language-server/tree/master/hie-compat#readme -bug-reports: https://github.com/haskell/haskell-language-server/issues - -source-repository head - type: git - location: https://github.com/haskell/haskell-language-server.git - -library - default-language: GHC2021 - build-depends: - base < 4.22, array, bytestring, containers, directory, filepath, transformers - build-depends: ghc >= 8.10, ghc-boot - ghc-options: -Wall -Wno-name-shadowing - - exposed-modules: - Compat.HieAst - Compat.HieBin - Compat.HieTypes - Compat.HieDebug - Compat.HieUtils - - if (impl(ghc >= 9.4)) - hs-source-dirs: src-reexport-ghc92 diff --git a/hie-compat/src-ghc92/Compat/HieAst.hs b/hie-compat/src-ghc92/Compat/HieAst.hs deleted file mode 100644 index dffa7bc78f..0000000000 --- a/hie-compat/src-ghc92/Compat/HieAst.hs +++ /dev/null @@ -1,2141 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE UndecidableSuperClasses #-} -{- HLINT ignore -} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -{- -Forked from GHC v9.2.3 to include record-dot-syntax type information in .hie files. - -Changes are marked with "CHANGED:" - -Main functions for .hie file generation --} - --- CHANGED: removed this include and updated the module declaration --- #include "HsVersions.h" --- --- module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where - -module Compat.HieAst ( enrichHie ) where - -import GHC.Utils.Outputable(ppr) - -import GHC.Prelude - -import GHC.Types.Avail ( Avails ) -import GHC.Data.Bag ( Bag, bagToList ) -import GHC.Types.Basic -import GHC.Data.BooleanFormula -import GHC.Core.Class ( className, classSCSelIds ) -import GHC.Core.Utils ( exprType ) -import GHC.Core.ConLike ( conLikeName, ConLike(RealDataCon) ) -import GHC.Core.TyCon ( TyCon, tyConClass_maybe ) -import GHC.Core.FVs -import GHC.Core.DataCon ( dataConNonlinearType ) -import GHC.Types.FieldLabel -import GHC.Hs -import GHC.Driver.Env -import GHC.Utils.Monad ( concatMapM, liftIO ) -import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, nameUnique ) -import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) -import GHC.Types.SrcLoc -import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) -import GHC.Core.Type ( mkVisFunTys, Type ) -import GHC.Core.Predicate -import GHC.Core.InstEnv -import GHC.Builtin.Types ( mkListTy, mkSumTy ) -import GHC.Tc.Types -import GHC.Tc.Types.Evidence -import GHC.Types.Var ( Id, Var, EvId, varName, varType, varUnique ) -import GHC.Types.Var.Env -import GHC.Builtin.Uniques -import GHC.Iface.Make ( mkIfaceExports ) -import GHC.Utils.Panic -import GHC.Utils.Misc -import GHC.Data.Maybe -import GHC.Data.FastString - -import GHC.Iface.Ext.Types -import GHC.Iface.Ext.Utils - -import GHC.Unit.Module ( ModuleName, ml_hs_file ) -import GHC.Unit.Module.ModSummary - -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 ) -import Data.Void ( Void, absurd ) -import Control.Monad ( forM_ ) -import Control.Monad.Trans.State.Strict -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Class ( lift ) -import GHC.HsToCore.Types -import GHC.HsToCore.Expr -import GHC.HsToCore.Monad - -{- Note [Updating HieAst for changes in the GHC AST] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -When updating the code in this file for changes in the GHC AST, you -need to pay attention to the following things: - -1) Symbols (Names/Vars/Modules) in the following categories: - - a) Symbols that appear in the source file that directly correspond to - something the user typed - b) Symbols that don't appear in the source, but should be in some sense - "visible" to a user, particularly via IDE tooling or the like. This - includes things like the names introduced by RecordWildcards (We record - all the names introduced by a (..) in HIE files), and will include implicit - parameters and evidence variables after one of my pending MRs lands. - -2) Subtrees that may contain such symbols, or correspond to a SrcSpan in - the file. This includes all `Located` things - -For 1), you need to call `toHie` for one of the following instances - -instance ToHie (Context (Located Name)) where ... -instance ToHie (Context (Located Var)) where ... -instance ToHie (IEContext (Located ModuleName)) where ... - -`Context` is a data type that looks like: - -data Context a = C ContextInfo a -- Used for names and bindings - -`ContextInfo` is defined in `GHC.Iface.Ext.Types`, and looks like - -data ContextInfo - = Use -- ^ regular variable - | MatchBind - | IEThing IEType -- ^ import/export - | TyDecl - -- | Value binding - | ValBind - BindType -- ^ whether or not the binding is in an instance - Scope -- ^ scope over which the value is bound - (Maybe Span) -- ^ span of entire binding - ... - -It is used to annotate symbols in the .hie files with some extra information on -the context in which they occur and should be fairly self explanatory. You need -to select one that looks appropriate for the symbol usage. In very rare cases, -you might need to extend this sum type if none of the cases seem appropriate. - -So, given a `Located Name` that is just being "used", and not defined at a -particular location, you would do the following: - - toHie $ C Use located_name - -If you select one that corresponds to a binding site, you will need to -provide a `Scope` and a `Span` for your binding. Both of these are basically -`SrcSpans`. - -The `SrcSpan` in the `Scope` is supposed to span over the part of the source -where the symbol can be legally allowed to occur. For more details on how to -calculate this, see Note [Capturing Scopes and other non local information] -in GHC.Iface.Ext.Ast. - -The binding `Span` is supposed to be the span of the entire binding for -the name. - -For a function definition `foo`: - -foo x = x + y - where y = x^2 - -The binding `Span` is the span of the entire function definition from `foo x` -to `x^2`. For a class definition, this is the span of the entire class, and -so on. If this isn't well defined for your bit of syntax (like a variable -bound by a lambda), then you can just supply a `Nothing` - -There is a test that checks that all symbols in the resulting HIE file -occur inside their stated `Scope`. This can be turned on by passing the --fvalidate-ide-info flag to ghc along with -fwrite-ide-info to generate the -.hie file. - -You may also want to provide a test in testsuite/test/hiefile that includes -a file containing your new construction, and tests that the calculated scope -is valid (by using -fvalidate-ide-info) - -For subtrees in the AST that may contain symbols, the procedure is fairly -straightforward. If you are extending the GHC AST, you will need to provide a -`ToHie` instance for any new types you may have introduced in the AST. - -Here is an extract from the `ToHie` instance for (LHsExpr (GhcPass p)): - - 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 - ] - HsConLikeOut _ con -> - [ toHie $ C Use $ L mspan $ conLikeName con - ] - ... - HsApp _ a b -> - [ toHie a - , toHie b - ] - -If your subtree is `Located` or has a `SrcSpan` available, the output list -should contain a HieAst `Node` corresponding to the subtree. You can use -either `makeNode` or `getTypeNode` for this purpose, depending on whether it -makes sense to assign a `Type` to the subtree. After this, you just need -to concatenate the result of calling `toHie` on all subexpressions and -appropriately annotated symbols contained in the subtree. - -The code above from the ToHie instance of `LhsExpr (GhcPass p)` is supposed -to work for both the renamed and typechecked source. `getTypeNode` is from -the `HasType` class defined in this file, and it has different instances -for `GhcTc` and `GhcRn` that allow it to access the type of the expression -when given a typechecked AST: - -class Data a => HasType a where - getTypeNode :: a -> HieM [HieAST Type] -instance HasType (LHsExpr GhcTc) where - getTypeNode e@(L spn e') = ... -- Actually get the type for this expression -instance HasType (LHsExpr GhcRn) where - getTypeNode (L spn e) = makeNode e spn -- Fallback to a regular `makeNode` without recording the type - -If your subtree doesn't have a span available, you can omit the `makeNode` -call and just recurse directly in to the subexpressions. - --} - --- These synonyms match those defined in compiler/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. --} -type VarMap a = DVarEnv (Var,a) -data HieState = HieState - { name_remapping :: NameEnv Id - , unlocated_ev_binds :: VarMap (S.Set ContextInfo) - -- These contain evidence bindings that we don't have a location for - -- These are placed at the top level Node in the HieAST after everything - -- else has been generated - -- This includes things like top level evidence bindings. - } - -addUnlocatedEvBind :: Var -> ContextInfo -> HieM () -addUnlocatedEvBind var ci = do - let go (a,b) (_,c) = (a,S.union b c) - lift $ modify' $ \s -> - s { unlocated_ev_binds = - extendDVarEnv_C go (unlocated_ev_binds s) - var (var,S.singleton ci) - } - -getUnlocatedEvBinds :: FastString -> HieM (NodeIdentifiers Type,[HieAST Type]) -getUnlocatedEvBinds file = do - binds <- lift $ gets unlocated_ev_binds - org <- ask - let elts = dVarEnvElts binds - - mkNodeInfo (n,ci) = (Right (varName n), IdentifierDetails (Just $ varType n) ci) - - go e@(v,_) (xs,ys) = case nameSrcSpan $ varName v of - RealSrcSpan spn _ - | srcSpanFile spn == file -> - let node = Node (mkSourcedNodeInfo org ni) spn [] - ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e] - in (xs,node:ys) - _ -> (mkNodeInfo e : xs,ys) - - (nis,asts) = foldr go ([],[]) elts - - pure $ (M.fromList nis, asts) - -initState :: HieState -initState = HieState emptyNameEnv emptyDVarEnv - -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 = extendNameEnv (name_remapping hs) (varName mono) poly} - -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 NodeOrigin (StateT HieState DsM) - --- | Construct an 'HieFile' from the outputs of the typechecker. -mkHieFile :: ModSummary - -> TcGblEnv - -> RenamedSource -> Hsc HieFile -mkHieFile ms ts rs = do - let src_file = expectJust "mkHieFile" (ml_hs_file $ ms_location ms) - src <- liftIO $ BS.readFile src_file - mkHieFileWithSource src_file src ms ts rs - --- | Construct an 'HieFile' from the outputs of the typechecker but don't --- read the source file again from disk. -mkHieFileWithSource :: FilePath - -> BS.ByteString - -> ModSummary - -> TcGblEnv - -> RenamedSource -> Hsc HieFile -mkHieFileWithSource src_file src ms ts rs = do - let tc_binds = tcg_binds ts - top_ev_binds = tcg_ev_binds ts - insts = tcg_insts ts - tcs = tcg_tcs ts - hsc_env <- Hsc $ \e w -> return (e, w) - (_msgs, res) <- liftIO $ initDs hsc_env ts $ getCompressedAsts tc_binds rs top_ev_binds insts tcs - let (asts',arr) = expectJust "mkHieFileWithSource" res - return $ HieFile - { hie_hs_file = src_file - , hie_module = ms_mod ms - , hie_types = arr - , hie_asts = asts' - -- mkIfaceExports sorts the AvailInfos for stability - , hie_exports = mkIfaceExports (tcg_exports ts) - , hie_hs_src = src - } - -getCompressedAsts :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon] - -> DsM (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat) -getCompressedAsts ts rs top_ev_binds insts tcs = do - asts <- enrichHie ts rs top_ev_binds insts tcs - return $ compressTypes asts - -enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon] - -> DsM (HieASTs Type) -enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs = - flip evalStateT initState $ flip runReaderT SourceInfo $ 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 - -- Add Instance bindings - forM_ insts $ \i -> - addUnlocatedEvBind (is_dfun i) (EvidenceVarBind (EvInstBind False (is_cls_nm i)) ModuleScope Nothing) - -- Add class parent bindings - forM_ tcs $ \tc -> - case tyConClass_maybe tc of - Nothing -> pure () - Just c -> forM_ (classSCSelIds c) $ \v -> - addUnlocatedEvBind v (EvidenceVarBind (EvInstBind True (className c)) ModuleScope Nothing) - let spanFile file children = case children of - [] -> realSrcLocSpan (mkRealSrcLoc file 1 1) - _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children) - (realSrcSpanEnd $ nodeSpan $ last children) - - flat_asts = concat - [ tasts - , rasts - , imps - , exps - ] - - modulify (HiePath file) xs' = do - - top_ev_asts :: [HieAST Type] <- do - let - l :: SrcSpanAnnA - l = noAnnSrcSpan (RealSrcSpan (realSrcLocSpan $ mkRealSrcLoc file 1 1) Nothing) - toHie $ EvBindContext ModuleScope Nothing - $ L l (EvBinds ev_bs) - - (uloc_evs,more_ev_asts) <- getUnlocatedEvBinds file - - let xs = mergeSortAsts $ xs' ++ top_ev_asts ++ more_ev_asts - span = spanFile file xs - - moduleInfo = SourcedNodeInfo - $ M.singleton SourceInfo - $ (simpleNodeInfo "Module" "Module") - {nodeIdentifiers = uloc_evs} - - moduleNode = Node moduleInfo span [] - - case mergeSortAsts $ moduleNode : xs of - [x] -> return x - xs -> panicDoc "enrichHie: mergeSortAsts retur:ed more than one result" (ppr $ map nodeSpan xs) - - asts' <- sequence - $ M.mapWithKey modulify - $ M.fromListWith (++) - $ map (\x -> (HiePath (srcSpanFile (nodeSpan x)),[x])) flat_asts - - let asts = HieASTs $ resolveTyVarScopes asts' - 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 - ] - -getRealSpanA :: SrcSpanAnn' ann -> Maybe Span -getRealSpanA la = getRealSpan (locA la) - -getRealSpan :: SrcSpan -> Maybe Span -getRealSpan (RealSrcSpan sp _) = Just sp -getRealSpan _ = Nothing - -grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan - , Data (HsLocalBinds (GhcPass p))) - => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan -grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (spanHsLocaLBinds bs) (map getLoc xs) - -bindingsOnly :: [Context Name] -> HieM [HieAST a] -bindingsOnly [] = pure [] -bindingsOnly (C c n : xs) = do - org <- ask - rest <- bindingsOnly xs - pure $ case nameSrcSpan n of - RealSrcSpan span _ -> Node (mkSourcedNodeInfo org nodeinfo) span [] : rest - where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info) - info = mempty{identInfo = S.singleton c} - _ -> rest - -concatM :: Monad m => [m [a]] -> m [a] -concatM xs = concat <$> sequence xs - -{- Note [Capturing Scopes and other non local information] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -toHie is a local transformation, 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 EvBindContext a = EvBindContext Scope (Maybe Span) a - -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 (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 -> [LocatedA a] -> [RScoped (LocatedA 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 $ getLocA 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 a) $ - listScopes patScope xs - --- | 'listScopes' specialised to 'HsPatSigType' -tScopes - :: Scope - -> Scope - -> [HsPatSigType (GhcPass a)] - -> [TScoped (HsPatSigType (GhcPass a))] -tScopes scope rhsScope xs = - map (\(RS sc a) -> TS (ResolvedScopes [scope, sc]) (unLoc a)) $ - listScopes rhsScope (map (\hsps -> L (getLoc $ hsps_body hsps) hsps) xs) - -- We make the HsPatSigType into a Located one by using the location of the underlying LHsType. - -- We then strip off the redundant location information afterward, and take the union of the given scope and those to the right when forming the TS. - --- | 'listScopes' specialised to 'TVScoped' things -tvScopes - :: TyVarScope - -> Scope - -> [LHsTyVarBndr flag (GhcPass a)] - -> [TVScoped (LHsTyVarBndr flag (GhcPass 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 - -This case in handled in the instance for HsPatSigType --} - -class HasLoc a where - -- ^ conveniently calculate locations for things without locations attached - loc :: a -> SrcSpan - -instance HasLoc thing => HasLoc (PScoped thing) where - loc (PS _ _ _ a) = loc a - -instance HasLoc (Located a) where - loc (L l _) = l - -instance HasLoc (LocatedA a) where - loc (L la _) = locA la - -instance HasLoc (LocatedN a) where - loc (L la _) = locA la - -instance HasLoc a => HasLoc [a] where - loc [] = noSrcSpan - loc xs = foldl1' combineSrcSpans $ map loc xs - -instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where - loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of - HsOuterImplicit{} -> - foldl1' combineSrcSpans [loc a, loc b, loc c] - HsOuterExplicit{hso_bndrs = tvs} -> - foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] - -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 - --- | The main worker class --- See Note [Updating HieAst for changes in the GHC AST] for more information --- on how to add/modify instances for this. -class ToHie a where - toHie :: a -> HieM [HieAST Type] - --- | Used to collect type info -class HasType a where - getTypeNode :: a -> HieM [HieAST Type] - -instance ToHie Void where - toHie v = absurd v - -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 (IEContext (LocatedA ModuleName)) where - toHie (IEC c (L (SrcSpanAnn _ (RealSrcSpan span _)) mname)) = do - org <- ask - pure $ [Node (mkSourcedNodeInfo org $ 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 a)) => ToHie (Context (LocatedN a)) where - toHie (C c (L l a)) = toHie (C c (L (locA l) a)) - -instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where - toHie (C c (L l a)) = toHie (C c (L (locA l) a)) - -instance ToHie (Context (Located Var)) where - toHie c = case c of - C context (L (RealSrcSpan span _) name') - | varUnique name' == mkBuiltinUnique 1 -> pure [] - -- `mkOneRecordSelector` makes a field var using this unique, which we ignore - | otherwise -> do - m <- lift $ gets name_remapping - org <- ask - let name = case lookupNameEnv m (varName name') of - Just var -> var - Nothing-> name' - ty = case isDataConId_maybe name' of - Nothing -> varType name' - Just dc -> dataConNonlinearType dc - pure - [Node - (mkSourcedNodeInfo org $ NodeInfo S.empty [] $ - M.singleton (Right $ varName name) - (IdentifierDetails (Just ty) - (S.singleton context))) - span - []] - C (EvidenceVarBind i _ sp) (L _ name) -> do - addUnlocatedEvBind name (EvidenceVarBind i ModuleScope sp) - pure [] - _ -> pure [] - -instance ToHie (Context (Located Name)) where - toHie c = case c of - C context (L (RealSrcSpan span _) name') - | nameUnique name' == mkBuiltinUnique 1 -> pure [] - -- `mkOneRecordSelector` makes a field var using this unique, which we ignore - | otherwise -> do - m <- lift $ gets name_remapping - org <- ask - let name = case lookupNameEnv m name' of - Just var -> varName var - Nothing -> name' - pure - [Node - (mkSourcedNodeInfo org $ NodeInfo S.empty [] $ - M.singleton (Right name) - (IdentifierDetails Nothing - (S.singleton context))) - span - []] - _ -> pure [] - -evVarsOfTermList :: EvTerm -> [EvId] -evVarsOfTermList (EvExpr e) = exprSomeFreeVarsList isEvVar e -evVarsOfTermList (EvTypeable _ ev) = - case ev of - EvTypeableTyCon _ e -> concatMap evVarsOfTermList e - EvTypeableTyApp e1 e2 -> concatMap evVarsOfTermList [e1,e2] - EvTypeableTrFun e1 e2 e3 -> concatMap evVarsOfTermList [e1,e2,e3] - EvTypeableTyLit e -> evVarsOfTermList e -evVarsOfTermList (EvFun{}) = [] - -instance ToHie (EvBindContext (LocatedA TcEvBinds)) where - toHie (EvBindContext sc sp (L span (EvBinds bs))) - = concatMapM go $ bagToList bs - where - go evbind = do - let evDeps = evVarsOfTermList $ eb_rhs evbind - depNames = EvBindDeps $ map varName evDeps - concatM $ - [ toHie (C (EvidenceVarBind (EvLetBind depNames) (combineScopes sc (mkScopeA span)) sp) - (L span $ eb_lhs evbind)) - , toHie $ map (C EvidenceVarUse . L span) $ evDeps - ] - toHie _ = pure [] - -instance ToHie (LocatedA HsWrapper) where - toHie (L osp wrap) - = case wrap of - (WpLet bs) -> toHie $ EvBindContext (mkScopeA osp) (getRealSpanA osp) (L osp bs) - (WpCompose a b) -> concatM $ - [toHie (L osp a), toHie (L osp b)] - (WpFun a b _ _) -> concatM $ - [toHie (L osp a), toHie (L osp b)] - (WpEvLam a) -> - toHie $ C (EvidenceVarBind EvWrapperBind (mkScopeA osp) (getRealSpanA osp)) - $ L osp a - (WpEvApp a) -> - concatMapM (toHie . C EvidenceVarUse . L osp) $ evVarsOfTermList a - _ -> pure [] - -instance HiePass p => HasType (LocatedA (HsBind (GhcPass p))) where - getTypeNode (L spn bind) = - case hiePass @p of - HieRn -> makeNode bind (locA spn) - HieTc -> case bind of - FunBind{fun_id = name} -> makeTypeNode bind (locA spn) (varType $ unLoc name) - _ -> makeNode bind (locA spn) - -instance HiePass p => HasType (LocatedA (Pat (GhcPass p))) where - getTypeNode (L spn pat) = - case hiePass @p of - HieRn -> makeNodeA pat spn - HieTc -> makeTypeNodeA pat spn (hsPatType pat) - --- | 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 HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where - getTypeNode e@(L spn e') = - case hiePass @p of - HieRn -> makeNodeA e' spn - HieTc -> - -- Some expression forms have their type immediately available - let tyOpt = case e' of - HsUnboundVar (HER _ ty _) _ -> Just ty - HsLit _ l -> Just (hsLitType l) - HsOverLit _ o -> Just (overLitType o) - - HsConLikeOut _ (RealDataCon con) -> Just (dataConNonlinearType con) - - 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 - Just t -> makeTypeNodeA e' spn t - Nothing - | skipDesugaring e' -> fallback - | otherwise -> do - (e, no_errs) <- lift $ lift $ discardWarningsDs $ askNoErrsDs $ dsLExpr e - if no_errs - then makeTypeNodeA e' spn . exprType $ e - else fallback - where - fallback = makeNodeA e' spn - - matchGroupType :: MatchGroupTc -> Type - matchGroupType (MatchGroupTc args res) = mkVisFunTys 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 GhcTc -> Bool - skipDesugaring e = case e of - HsVar{} -> False - HsConLikeOut{} -> False - HsRecFld{} -> False - HsOverLabel{} -> False - HsIPVar{} -> False - XExpr (WrapExpr {}) -> False - -- CHANGED: the line below makes record-dot-syntax types work - XExpr (ExpansionExpr {}) -> False - _ -> True - -data HiePassEv p where - HieRn :: HiePassEv 'Renamed - HieTc :: HiePassEv 'Typechecked - -class ( IsPass p - , HiePass (NoGhcTcPass p) - , ModifyState (IdGhcP p) - , Data (GRHS (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) - , Data (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) - , Data (Match (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) - , Data (Stmt (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) - , Data (Stmt (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) - , Data (HsExpr (GhcPass p)) - , Data (HsCmd (GhcPass p)) - , Data (AmbiguousFieldOcc (GhcPass p)) - , Data (HsCmdTop (GhcPass p)) - , Data (GRHS (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) - , Data (HsSplice (GhcPass p)) - , Data (HsLocalBinds (GhcPass p)) - , Data (FieldOcc (GhcPass p)) - , Data (HsTupArg (GhcPass p)) - , Data (IPBind (GhcPass p)) - , ToHie (Context (Located (IdGhcP p))) - , ToHie (RFContext (Located (AmbiguousFieldOcc (GhcPass p)))) - , ToHie (RFContext (Located (FieldOcc (GhcPass p)))) - , ToHie (TScoped (LHsWcType (GhcPass (NoGhcTcPass p)))) - , ToHie (TScoped (LHsSigWcType (GhcPass (NoGhcTcPass p)))) - , Anno (IdGhcP p) ~ SrcSpanAnnN - ) - => HiePass p where - hiePass :: HiePassEv p - -instance HiePass 'Renamed where - hiePass = HieRn -instance HiePass 'Typechecked where - hiePass = HieTc - -instance ToHie (Context (Located NoExtField)) where - toHie _ = pure [] - -type AnnoBody p body - = ( Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) - ~ SrcSpanAnnA - , Anno [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] - ~ SrcSpanAnnL - , Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) - ~ SrcSpan - , Anno (StmtLR (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA - - , Data (body (GhcPass p)) - , Data (Match (GhcPass p) (LocatedA (body (GhcPass p)))) - , Data (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) - , Data (Stmt (GhcPass p) (LocatedA (body (GhcPass p)))) - - , IsPass p - ) - -instance HiePass p => ToHie (BindContext (LocatedA (HsBind (GhcPass p)))) where - toHie (BC context scope b@(L span bind)) = - concatM $ getTypeNode b : case bind of - FunBind{fun_id = name, fun_matches = matches, fun_ext = wrap} -> - [ toHie $ C (ValBind context scope $ getRealSpanA span) name - , toHie matches - , case hiePass @p of - HieTc -> toHie $ L span wrap - _ -> pure [] - ] - PatBind{pat_lhs = lhs, pat_rhs = rhs} -> - [ toHie $ PS (getRealSpan (locA span)) scope NoScope lhs - , toHie rhs - ] - VarBind{var_rhs = expr} -> - [ toHie expr - ] - AbsBinds{ abs_exports = xs, abs_binds = binds - , abs_ev_binds = ev_binds - , abs_ev_vars = ev_vars } -> - [ lift (modify (modifyState xs)) >> -- Note [Name Remapping] - (toHie $ fmap (BC context scope) binds) - , toHie $ map (L span . abe_wrap) xs - , toHie $ - map (EvBindContext (mkScopeA span) (getRealSpanA span) - . L span) ev_binds - , toHie $ - map (C (EvidenceVarBind EvSigBind - (mkScopeA span) - (getRealSpanA span)) - . L span) ev_vars - ] - PatSynBind _ psb -> - [ toHie $ L (locA span) psb -- PatSynBinds only occur at the top level - ] - -instance ( HiePass p - , AnnoBody p body - , ToHie (LocatedA (body (GhcPass p))) - ) => ToHie (MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))) where - toHie mg = case mg of - MG{ mg_alts = (L span alts) , mg_origin = origin} -> - local (setOrigin origin) $ concatM - [ locOnly (locA span) - , toHie alts - ] - -setOrigin :: Origin -> NodeOrigin -> NodeOrigin -setOrigin FromSource _ = SourceInfo -setOrigin Generated _ = GeneratedInfo - -instance HiePass p => ToHie (Located (PatSynBind (GhcPass p) (GhcPass p))) 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 patScope pat - , toHie dir - ] - where - lhsScope = combineScopes varScope detScope - varScope = mkLScopeN var - patScope = mkScopeA $ getLoc pat - detScope = case dets of - (PrefixCon _ args) -> foldr combineScopes NoScope $ map mkLScopeN args - (InfixCon a b) -> combineScopes (mkLScopeN a) (mkLScopeN b) - (RecCon r) -> foldr go NoScope r - go (RecordPatSynField a b) c = combineScopes c - $ combineScopes (mkLScopeN (rdrNameFieldOcc a)) (mkLScopeN b) - detSpan = case detScope of - LocalScope a -> Just a - _ -> Nothing - -- CHANGED: removed ASSERT - -- toBind (PrefixCon ts args) = ASSERT(null ts) PrefixCon ts $ map (C Use) args - toBind (PrefixCon ts args) = PrefixCon ts $ map (C Use) args - toBind (InfixCon a b) = InfixCon (C Use a) (C Use b) - toBind (RecCon r) = RecCon $ map (PSC detSpan) r - -instance HiePass p => ToHie (HsPatSynDir (GhcPass p)) where - toHie dir = case dir of - ExplicitBidirectional mg -> toHie mg - _ -> pure [] - -instance ( HiePass p - , Data (body (GhcPass p)) - , AnnoBody p body - , ToHie (LocatedA (body (GhcPass p))) - ) => ToHie (LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))) where - toHie (L span m ) = concatM $ node : 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 - ] - where - node = case hiePass @p of - HieTc -> makeNodeA m span - HieRn -> makeNodeA m span - -instance HiePass p => ToHie (HsMatchContext (GhcPass p)) where - toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name - toHie (StmtCtxt a) = toHie a - toHie _ = pure [] - -instance HiePass p => ToHie (HsStmtContext (GhcPass p)) where - toHie (PatGuard a) = toHie a - toHie (ParStmtCtxt a) = toHie a - toHie (TransStmtCtxt a) = toHie a - toHie _ = pure [] - -instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where - toHie (PS rsp scope pscope lpat@(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 (mkLScopeA 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 - ] - ConPat {pat_con = con, pat_args = dets, pat_con_ext = ext} -> - case hiePass @p of - HieTc -> - [ toHie $ C Use $ fmap conLikeName con - , toHie $ contextify dets - , let ev_binds = cpt_binds ext - ev_vars = cpt_dicts ext - wrap = cpt_wrap ext - evscope = mkScopeA ospan `combineScopes` scope `combineScopes` pscope - in concatM [ toHie $ EvBindContext scope rsp $ L ospan ev_binds - , toHie $ L ospan wrap - , toHie $ map (C (EvidenceVarBind EvPatternBind evscope rsp) - . L ospan) ev_vars - ] - ] - HieRn -> - [ toHie $ C Use 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 - , case hiePass @p of - HieTc -> - let cscope = mkLScopeA pat in - toHie $ TS (ResolvedScopes [cscope, scope, pscope]) - sig - HieRn -> pure [] - ] - XPat e -> - case hiePass @p of - HieTc -> - let CoPat wrap pat _ = e - in [ toHie $ L ospan wrap - , toHie $ PS rsp scope pscope $ (L ospan pat) - ] --- CHANGED: removed preprocessor stuff --- #if __GLASGOW_HASKELL__ < 811 --- HieRn -> [] --- #endif - where - contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a) - -> HsConDetails (TScoped (HsPatSigType (NoGhcTc (GhcPass p)))) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a))) - contextify (PrefixCon tyargs args) = PrefixCon (tScopes scope argscope tyargs) (patScopes rsp scope pscope args) - where argscope = foldr combineScopes NoScope $ map mkLScopeA 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 :: RScoped (LocatedA (HsRecField' id a1)) - -> LocatedA (HsRecField' id (PScoped a1)) -- AZ - go (RS fscope (L spn (HsRecField x lbl pat pun))) = - L spn $ HsRecField x lbl (PS rsp scope fscope pat) pun - scoped_fds = listScopes pscope fds - -instance ToHie (TScoped (HsPatSigType GhcRn)) where - toHie (TS sc (HsPS (HsPSRn wcs tvs) body@(L span _))) = concatM $ - [ bindingsOnly $ map (C $ TyVarBind (mkScopeA span) sc) (wcs++tvs) - , toHie body - ] - -- See Note [Scoping Rules for SigPat] - -instance ( ToHie (LocatedA (body (GhcPass p))) - , HiePass p - , AnnoBody p body - ) => ToHie (GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))) where - toHie grhs = concatM $ case grhs of - GRHSs _ grhss binds -> - [ toHie grhss - , toHie $ RS (mkScope $ grhss_span grhs) binds - ] - -instance ( ToHie (LocatedA (body (GhcPass p))) - , HiePass p - , AnnoBody p body - ) => ToHie (Located (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))) where - toHie (L span g) = concatM $ node : case g of - GRHS _ guards body -> - [ toHie $ listScopes (mkLScopeA body) guards - , toHie body - ] - where - node = case hiePass @p of - HieRn -> makeNode g span - HieTc -> makeNode g span - -instance HiePass p => ToHie (LocatedA (HsExpr (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 _ _ -> [] -- there is an unbound name here, but that causes trouble - HsConLikeOut _ con -> - [ toHie $ C Use $ L mspan $ conLikeName con - ] - HsRecFld _ fld -> - [ toHie $ RFC RecFieldOcc Nothing (L (locA 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 (mkLScopeA expr) binds - , toHie expr - ] - HsDo _ _ (L ispan stmts) -> - [ locOnly (locA ispan) - , toHie $ listScopes NoScope stmts - ] - ExplicitList _ exprs -> - [ toHie exprs - ] - RecordCon { rcon_con = con, rcon_flds = binds} -> - [ toHie $ C Use $ con_name - , toHie $ RC RecFieldAssign $ binds - ] - where - con_name :: LocatedN Name - con_name = case hiePass @p of -- Like ConPat - HieRn -> con - HieTc -> fmap conLikeName con - RecordUpd {rupd_expr = expr, rupd_flds = Left upds}-> - [ toHie expr - , toHie $ map (RC RecFieldAssign) upds - ] - RecordUpd {rupd_expr = expr, rupd_flds = Right _}-> - [ toHie expr - ] - ExprWithTySig _ expr sig -> - [ toHie expr - , toHie $ TS (ResolvedScopes [mkLScopeA expr]) sig - ] - ArithSeq _ _ info -> - [ toHie info - ] - HsPragE _ _ expr -> - [ toHie expr - ] - HsProc _ pat cmdtop -> - [ toHie $ PS Nothing (mkLScope cmdtop) NoScope pat - , toHie cmdtop - ] - HsStatic _ expr -> - [ toHie expr - ] - HsTick _ _ expr -> - [ toHie expr - ] - HsBinTick _ _ _ expr -> - [ toHie expr - ] - HsBracket _ b -> - [ toHie b - ] - HsRnBracketOut _ b p -> - [ toHie b - , toHie p - ] - HsTcBracketOut _ _wrap b p -> - [ toHie b - , toHie p - ] - HsSpliceE _ x -> - [ toHie $ L mspan x - ] - HsGetField {} -> [] - HsProjection {} -> [] - XExpr x - | GhcTc <- ghcPass @p - , WrapExpr (HsWrap w a) <- x - -> [ toHie $ L mspan a - , toHie (L mspan w) - ] - | GhcTc <- ghcPass @p - , ExpansionExpr (HsExpanded _ b) <- x - -> [ toHie (L mspan b) - ] - | otherwise -> [] - --- NOTE: no longer have the location -instance HiePass p => ToHie (HsTupArg (GhcPass p)) where - toHie arg = concatM $ case arg of - Present _ expr -> - [ toHie expr - ] - Missing _ -> [] - -instance ( ToHie (LocatedA (body (GhcPass p))) - , AnnoBody p body - , HiePass p - ) => ToHie (RScoped (LocatedA (Stmt (GhcPass p) (LocatedA (body (GhcPass p)))))) where - toHie (RS scope (L span stmt)) = concatM $ node : case stmt of - LastStmt _ body _ _ -> - [ toHie body - ] - BindStmt _ pat body -> - [ toHie $ PS (getRealSpan $ getLocA 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 = L _ stmts} -> - [ toHie $ map (RS $ combineScopes scope (mkScope (locA span))) stmts - ] - where - node = case hiePass @p of - HieTc -> makeNodeA stmt span - HieRn -> makeNodeA stmt span - -instance HiePass p => ToHie (RScoped (HsLocalBinds (GhcPass p))) where - toHie (RS scope binds) = concatM $ makeNode binds (spanHsLocaLBinds binds) : case binds of - EmptyLocalBinds _ -> [] - HsIPBinds _ ipbinds -> case ipbinds of - IPBinds evbinds xs -> let sc = combineScopes scope $ scopeHsLocaLBinds binds - sp :: SrcSpanAnnA - sp = noAnnSrcSpan $ spanHsLocaLBinds binds in - [ - case hiePass @p of - HieTc -> toHie $ EvBindContext sc (getRealSpan $ locA sp) $ L sp evbinds - HieRn -> pure [] - , toHie $ map (RS sc) xs - ] - HsValBinds _ valBinds -> - [ - toHie $ RS (combineScopes scope (scopeHsLocaLBinds binds)) - valBinds - ] - - -scopeHsLocaLBinds :: HsLocalBinds (GhcPass p) -> Scope -scopeHsLocaLBinds (HsValBinds _ (ValBinds _ bs sigs)) - = foldr combineScopes NoScope (bsScope ++ sigsScope) - where - bsScope :: [Scope] - bsScope = map (mkScopeA . getLoc) $ bagToList bs - sigsScope :: [Scope] - sigsScope = map (mkScope . getLocA) sigs -scopeHsLocaLBinds (HsValBinds _ (XValBindsLR (NValBinds bs sigs))) - = foldr combineScopes NoScope (bsScope ++ sigsScope) - where - bsScope :: [Scope] - bsScope = map (mkScopeA . getLoc) $ concatMap (bagToList . snd) bs - sigsScope :: [Scope] - sigsScope = map (mkScope . getLocA) sigs - -scopeHsLocaLBinds (HsIPBinds _ (IPBinds _ bs)) - = foldr combineScopes NoScope (map (mkScopeA . getLoc) bs) -scopeHsLocaLBinds (EmptyLocalBinds _) = NoScope - - -instance HiePass p => ToHie (RScoped (LocatedA (IPBind (GhcPass p)))) where - toHie (RS scope (L sp bind)) = concatM $ makeNodeA bind sp : case bind of - IPBind _ (Left _) expr -> [toHie expr] - IPBind _ (Right v) expr -> - [ toHie $ C (EvidenceVarBind EvImplicitBind scope (getRealSpanA sp)) - $ L sp v - , toHie expr - ] - -instance HiePass p => ToHie (RScoped (HsValBindsLR (GhcPass p) (GhcPass p))) 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 HiePass p => ToHie (RScoped (NHsValBindsLR (GhcPass p))) 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 arg , HasLoc arg , Data arg - , HiePass p ) => ToHie (RContext (HsRecFields (GhcPass p) arg)) where - toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields - -instance ( ToHie (RFContext (Located label)) - , ToHie arg, HasLoc arg, Data arg - , Data label - ) => ToHie (RContext (LocatedA (HsRecField' label arg))) where - toHie (RC c (L span recfld)) = concatM $ makeNode recfld (locA span) : case recfld of - HsRecField _ label expr _ -> - [ toHie $ RFC c (getRealSpan $ loc expr) label - , toHie expr - ] - -instance ToHie (RFContext (Located (FieldOcc GhcRn))) where - toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan name) - ] - -instance ToHie (RFContext (Located (FieldOcc GhcTc))) where - toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc var _ -> - [ toHie $ C (RecField c rhs) (L nspan var) - ] - -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 _ -> - [ ] - -instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where - toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of - Unambiguous var _ -> - [ toHie $ C (RecField c rhs) (L nspan var) - ] - Ambiguous var _ -> - [ toHie $ C (RecField c rhs) (L nspan var) - ] - -instance HiePass p => 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 - ] - -instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg rec) where - toHie (PrefixCon tyargs args) = concatM [ toHie tyargs, toHie args ] - toHie (RecCon rec) = toHie rec - toHie (InfixCon a b) = concatM [ toHie a, toHie b] - -instance ToHie (HsConDeclGADTDetails GhcRn) where - toHie (PrefixConGADT args) = toHie args - toHie (RecConGADT rec) = toHie rec - -instance HiePass p => ToHie (Located (HsCmdTop (GhcPass p))) where - toHie (L span top) = concatM $ makeNode top span : case top of - HsCmdTop _ cmd -> - [ toHie cmd - ] - -instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where - toHie (L span cmd) = concatM $ makeNodeA 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 - ] - HsCmdLamCase _ alts -> - [ toHie alts - ] - HsCmdIf _ _ a b c -> - [ toHie a - , toHie b - , toHie c - ] - HsCmdLet _ binds cmd' -> - [ toHie $ RS (mkLScopeA cmd') binds - , toHie cmd' - ] - HsCmdDo _ (L ispan stmts) -> - [ locOnly (locA ispan) - , toHie $ listScopes NoScope stmts - ] - XCmd _ -> [] - -instance ToHie (TyClGroup GhcRn) where - toHie TyClGroup{ group_tyclds = classes - , group_roles = roles - , group_kisigs = sigs - , group_instds = instances } = - concatM - [ toHie classes - , toHie sigs - , toHie roles - , toHie instances - ] - -instance ToHie (LocatedA (TyClDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - FamDecl {tcdFam = fdecl} -> - [ toHie ((L span fdecl) :: LFamilyDecl GhcRn) - ] - SynDecl {tcdLName = name, tcdTyVars = vars, tcdRhs = typ} -> - [ toHie $ C (Decl SynDec $ getRealSpanA span) name - , toHie $ TS (ResolvedScopes [mkScope $ getLocA typ]) vars - , toHie typ - ] - DataDecl {tcdLName = name, tcdTyVars = vars, tcdDataDefn = defn} -> - [ toHie $ C (Decl DataDec $ getRealSpanA span) name - , toHie $ TS (ResolvedScopes [quant_scope, rhs_scope]) vars - , toHie defn - ] - where - quant_scope = mkLScopeA $ fromMaybe (noLocA []) $ dd_ctxt defn - rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc - sig_sc = maybe NoScope mkLScopeA $ dd_kindSig defn - con_sc = foldr combineScopes NoScope $ map mkLScopeA $ dd_cons defn - deriv_sc = foldr combineScopes NoScope $ map 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 $ getRealSpanA span) name - , toHie context - , toHie $ TS (ResolvedScopes [context_scope, rhs_scope]) vars - , toHie deps - , toHie $ map (SC $ SI ClassSig $ getRealSpanA span) sigs - , toHie $ fmap (BC InstanceBind ModuleScope) meths - , toHie typs - , concatMapM (locOnly . getLocA) deftyps - , toHie deftyps - ] - where - context_scope = mkLScopeA $ fromMaybe (noLocA []) context - rhs_scope = foldl1' combineScopes $ map mkScope - [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] - -instance ToHie (LocatedA (FamilyDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - FamilyDecl _ info _ name vars _ sig inj -> - [ toHie $ C (Decl FamDec $ getRealSpanA 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 - -instance ToHie (FamilyInfo GhcRn) where - toHie (ClosedTypeFamily (Just eqns)) = concatM $ - [ concatMapM (locOnly . getLocA) eqns - , toHie $ map go eqns - ] - where - go (L l ib) = TS (ResolvedScopes [mkScopeA l]) ib - toHie _ = pure [] - -instance ToHie (RScoped (Located (FamilyResultSig 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 - ] - -instance ToHie (LocatedA (FunDep GhcRn)) where - toHie (L span fd@(FunDep _ lhs rhs)) = concatM $ - [ makeNode fd (locA span) - , toHie $ map (C Use) lhs - , toHie $ map (C Use) rhs - ] - - -instance ToHie (TScoped (FamEqn GhcRn (HsDataDefn GhcRn))) where - toHie (TS _ f) = toHie f - -instance ToHie (TScoped (FamEqn GhcRn (LocatedA (HsType GhcRn)))) where - toHie (TS _ f) = toHie f - -instance (ToHie rhs, HasLoc rhs) - => ToHie (FamEqn GhcRn rhs) where - toHie fe@(FamEqn _ var outer_bndrs pats _ rhs) = concatM $ - [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var - , toHie $ TVS (ResolvedScopes []) scope outer_bndrs - , toHie pats - , toHie rhs - ] - where scope = combineScopes patsScope rhsScope - patsScope = mkScope (loc pats) - rhsScope = mkScope (loc rhs) - -instance ToHie (Located (InjectivityAnn 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 - ] - -instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where - toHie (L span clauses) = concatM - [ locOnly span - , toHie clauses - ] - -instance ToHie (Located (HsDerivingClause GhcRn)) where - toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat dct -> - [ toHie strat - , toHie dct - ] - -instance ToHie (LocatedC (DerivClauseTys GhcRn)) where - toHie (L span dct) = concatM $ makeNodeA dct span : case dct of - DctSingle _ ty -> [ toHie $ TS (ResolvedScopes []) ty ] - DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] - -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 (LocatedP OverlapMode) where - toHie (L span _) = locOnly (locA span) - -instance ToHie a => ToHie (HsScaled GhcRn a) where - toHie (HsScaled w t) = concatM [toHie (arrowToHsType w), toHie t] - -instance ToHie (LocatedA (ConDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of - ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs - , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ } -> - [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names - , case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_vars} -> - bindingsOnly $ map (C $ TyVarBind (mkScopeA outer_bndrs_loc) resScope) - imp_vars - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - toHie $ tvScopes resScope NoScope exp_bndrs - , toHie ctx - , toHie args - , toHie typ - ] - where - rhsScope = combineScopes argsScope tyScope - ctxScope = maybe NoScope mkLScopeA ctx - argsScope = case args of - PrefixConGADT xs -> scaled_args_scope xs - RecConGADT x -> mkLScopeA x - tyScope = mkLScopeA typ - resScope = ResolvedScopes [ctxScope, rhsScope] - ConDeclH98 { con_name = name, con_ex_tvs = qvars - , con_mb_cxt = ctx, con_args = dets } -> - [ toHie $ C (Decl ConDec $ getRealSpan (locA span)) name - , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars - , toHie ctx - , toHie dets - ] - where - rhsScope = combineScopes ctxScope argsScope - ctxScope = maybe NoScope mkLScopeA ctx - argsScope = case dets of - PrefixCon _ xs -> scaled_args_scope xs - InfixCon a b -> scaled_args_scope [a, b] - RecCon x -> mkLScopeA x - where scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope - scaled_args_scope = foldr combineScopes NoScope . map (mkLScopeA . hsScaledThing) - -instance ToHie (LocatedL [LocatedA (ConDeclField GhcRn)]) where - toHie (L span decls) = concatM $ - [ locOnly (locA span) - , toHie decls - ] - -instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) where - toHie (TS sc (HsWC names a)) = concatM $ - [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names - , toHie $ TS sc a - ] - where span = loc a - -instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where - toHie (TS sc (HsWC names a)) = concatM $ - [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names - , toHie a - ] - where span = loc a - -instance ToHie (LocatedA (StandaloneKindSig GhcRn)) where - toHie (L sp sig) = concatM [makeNodeA sig sp, toHie sig] - -instance ToHie (StandaloneKindSig GhcRn) where - toHie sig = concatM $ case sig of - StandaloneKindSig _ name typ -> - [ toHie $ C TyDecl name - , toHie $ TS (ResolvedScopes []) typ - ] - -instance HiePass p => ToHie (SigContext (LocatedA (Sig (GhcPass p)))) where - toHie (SC (SI styp msp) (L sp sig)) = - case hiePass @p of - HieTc -> pure [] - HieRn -> concatM $ makeNodeA 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 $ getRealSpanA 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 - , maybe (pure []) (locOnly . getLoc) mtxt - ] - CompleteMatchSig _ _ (L ispan names) typ -> - [ locOnly ispan - , toHie $ map (C Use) names - , toHie $ fmap (C Use) typ - ] - -instance ToHie (TScoped (LocatedA (HsSigType GhcRn))) where - toHie (TS tsc (L span t@HsSig{sig_bndrs=bndrs,sig_body=body})) = concatM $ makeNodeA t span : - [ toHie (TVS tsc (mkScopeA span) bndrs) - , toHie body - ] - --- Check this -instance Data flag => ToHie (TVScoped (HsOuterTyVarBndrs flag GhcRn)) where - toHie (TVS tsc sc bndrs) = case bndrs of - HsOuterImplicit xs -> bindingsOnly $ map (C $ TyVarBind sc tsc) xs - HsOuterExplicit _ xs -> toHie $ tvScopes tsc sc xs - -instance ToHie (LocatedA (HsType GhcRn)) where - toHie (L span t) = concatM $ makeNode t (locA span) : case t of - HsForAllTy _ tele body -> - let scope = mkScope $ getLocA body in - [ case tele of - HsForAllVis { hsf_vis_bndrs = bndrs } -> - toHie $ tvScopes (ResolvedScopes []) scope bndrs - HsForAllInvis { hsf_invis_bndrs = bndrs } -> - toHie $ tvScopes (ResolvedScopes []) scope 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 ki - ] - HsFunTy _ w a b -> - [ toHie (arrowToHsType w) - , 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) = locOnly sp - -instance Data flag => ToHie (TVScoped (LocatedA (HsTyVarBndr flag GhcRn))) where - toHie (TVS tsc sc (L span bndr)) = concatM $ makeNodeA bndr span : case bndr of - UserTyVar _ _ var -> - [ toHie $ C (TyVarBind sc tsc) var - ] - KindedTyVar _ _ var kind -> - [ toHie $ C (TyVarBind sc tsc) var - , toHie kind - ] - -instance ToHie (TScoped (LHsQTyVars GhcRn)) where - toHie (TS sc (HsQTvs implicits vars)) = concatM $ - [ bindingsOnly bindings - , toHie $ tvScopes sc NoScope vars - ] - where - varLoc = loc vars - bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits - -instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where - toHie (L span tys) = concatM $ - [ locOnly (locA span) - , toHie tys - ] - -instance ToHie (LocatedA (ConDeclField GhcRn)) where - toHie (L span field) = concatM $ makeNode field (locA span) : case field of - ConDeclField _ fields typ _ -> - [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields - , toHie typ - ] - -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 (LocatedA (SpliceDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - SpliceDecl _ splice _ -> - [ toHie splice - ] - -instance ToHie (HsBracket a) where - toHie _ = pure [] - -instance ToHie PendingRnSplice where - toHie _ = pure [] - -instance ToHie PendingTcSplice where - toHie _ = pure [] - -instance ToHie (LBooleanFormula (LocatedN Name)) where - toHie (L span form) = concatM $ makeNode form (locA 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 HiePass p => ToHie (LocatedA (HsSplice (GhcPass p))) where - toHie (L span sp) = concatM $ makeNodeA sp span : case sp of - HsTypedSplice _ _ _ expr -> - [ toHie expr - ] - HsUntypedSplice _ _ _ expr -> - [ toHie expr - ] - HsQuasiQuote _ _ _ ispan _ -> - [ locOnly ispan - ] - HsSpliced _ _ _ -> - [] - XSplice x -> case ghcPass @p of --- CHANGED: removed preprocessor stuff --- #if __GLASGOW_HASKELL__ < 811 --- GhcPs -> noExtCon x --- GhcRn -> noExtCon x --- #endif - GhcTc -> case x of - HsSplicedT _ -> [] - -instance ToHie (LocatedA (RoleAnnotDecl GhcRn)) where - toHie (L span annot) = concatM $ makeNodeA annot span : case annot of - RoleAnnotDecl _ var roles -> - [ toHie $ C Use var - , concatMapM (locOnly . getLoc) roles - ] - -instance ToHie (LocatedA (InstDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - ClsInstD _ d -> - [ toHie $ L span d - ] - DataFamInstD _ d -> - [ toHie $ L span d - ] - TyFamInstD _ d -> - [ toHie $ L span d - ] - -instance ToHie (LocatedA (ClsInstDecl GhcRn)) where - toHie (L span decl) = concatM - [ toHie $ TS (ResolvedScopes [mkScopeA span]) $ cid_poly_ty decl - , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl - , toHie $ map (SC $ SI InstSig $ getRealSpanA span) $ cid_sigs decl - , concatMapM (locOnly . getLocA) $ cid_tyfam_insts decl - , toHie $ cid_tyfam_insts decl - , concatMapM (locOnly . getLocA) $ cid_datafam_insts decl - , toHie $ cid_datafam_insts decl - , toHie $ cid_overlap_mode decl - ] - -instance ToHie (LocatedA (DataFamInstDecl GhcRn)) where - toHie (L sp (DataFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScopeA sp]) d - -instance ToHie (LocatedA (TyFamInstDecl GhcRn)) where - toHie (L sp (TyFamInstDecl _ d)) = toHie $ TS (ResolvedScopes [mkScopeA sp]) d - -instance HiePass p => ToHie (Context (FieldOcc (GhcPass p))) where - toHie (C c (FieldOcc n (L l _))) = case hiePass @p of - HieTc -> toHie (C c (L l n)) - HieRn -> toHie (C c (L l n)) - -instance HiePass p => ToHie (PatSynFieldContext (RecordPatSynField (GhcPass p))) where - toHie (PSC sp (RecordPatSynField a b)) = concatM $ - [ toHie $ C (RecField RecFieldDecl sp) a - , toHie $ C Use b - ] - -instance ToHie (LocatedA (DerivDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - DerivDecl _ typ strat overlap -> - [ toHie $ TS (ResolvedScopes []) typ - , toHie strat - , toHie overlap - ] - -instance ToHie (LocatedA (FixitySig GhcRn)) where - toHie (L span sig) = concatM $ makeNodeA sig span : case sig of - FixitySig _ vars _ -> - [ toHie $ map (C Use) vars - ] - -instance ToHie (LocatedA (DefaultDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - DefaultDecl _ typs -> - [ toHie typs - ] - -instance ToHie (LocatedA (ForeignDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - ForeignImport {fd_name = name, fd_sig_ty = sig, fd_fi = fi} -> - [ toHie $ C (ValBind RegularBind ModuleScope $ getRealSpanA 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 - ] - -instance ToHie ForeignImport where - toHie (CImport (L a _) (L b _) _ _ (L c _)) = concatM $ - [ locOnly a - , locOnly b - , locOnly c - ] - -instance ToHie ForeignExport where - toHie (CExport (L a _) (L b _)) = concatM $ - [ locOnly a - , locOnly b - ] - -instance ToHie (LocatedA (WarnDecls GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - Warnings _ _ warnings -> - [ toHie warnings - ] - -instance ToHie (LocatedA (WarnDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of - Warning _ vars _ -> - [ toHie $ map (C Use) vars - ] - -instance ToHie (LocatedA (AnnDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - HsAnnotation _ _ prov expr -> - [ toHie prov - , toHie expr - ] - -instance ToHie (AnnProvenance GhcRn) where - toHie (ValueAnnProvenance a) = toHie $ C Use a - toHie (TypeAnnProvenance a) = toHie $ C Use a - toHie ModuleAnnProvenance = pure [] - -instance ToHie (LocatedA (RuleDecls GhcRn)) where - toHie (L span decl) = concatM $ makeNodeA decl span : case decl of - HsRules _ _ rules -> - [ toHie rules - ] - -instance ToHie (LocatedA (RuleDecl GhcRn)) where - toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM - [ makeNodeA r span - , locOnly $ getLoc rname - , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs - , toHie $ map (RS $ mkScope (locA 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 = mkLScopeA exprA - exprB_sc = mkLScopeA exprB - -instance ToHie (RScoped (Located (RuleBndr 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 - ] - -instance ToHie (LocatedA (ImportDecl GhcRn)) where - toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of - ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } -> - [ toHie $ IEC Import name - , toHie $ fmap (IEC ImportAs) as - , maybe (pure []) goIE hidden - ] - where - goIE (hiding, (L sp liens)) = concatM $ - [ locOnly (locA sp) - , toHie $ map (IEC c) liens - ] - where - c = if hiding then ImportHiding else Import - -instance ToHie (IEContext (LocatedA (IE GhcRn))) where - toHie (IEC c (L span ie)) = concatM $ makeNode ie (locA span) : case ie of - IEVar _ n -> - [ toHie $ IEC c n - ] - IEThingAbs _ n -> - [ toHie $ IEC c n - ] - IEThingAll _ n -> - [ toHie $ IEC c n - ] - IEThingWith flds n _ ns -> - [ toHie $ IEC c n - , toHie $ map (IEC c) ns - , toHie $ map (IEC c) flds - ] - IEModuleContents _ n -> - [ toHie $ IEC c n - ] - IEGroup _ _ _ -> [] - IEDoc _ _ -> [] - IEDocNamed _ _ -> [] - -instance ToHie (IEContext (LIEWrappedName Name)) where - toHie (IEC c (L span iewn)) = concatM $ makeNodeA 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 FieldLabel)) where - toHie (IEC c (L span lbl)) = concatM - [ makeNode lbl span - , toHie $ C (IEThing c) $ L span (flSelector lbl) - ] diff --git a/hie-compat/src-reexport-ghc9/Compat/HieBin.hs b/hie-compat/src-reexport-ghc9/Compat/HieBin.hs deleted file mode 100644 index 254e1db6d3..0000000000 --- a/hie-compat/src-reexport-ghc9/Compat/HieBin.hs +++ /dev/null @@ -1,8 +0,0 @@ -{- -Binary serialization for .hie files. --} - -module Compat.HieBin ( module GHC.Iface.Ext.Binary) -where - -import GHC.Iface.Ext.Binary diff --git a/hie-compat/src-reexport-ghc9/Compat/HieDebug.hs b/hie-compat/src-reexport-ghc9/Compat/HieDebug.hs deleted file mode 100644 index 872da67c2b..0000000000 --- a/hie-compat/src-reexport-ghc9/Compat/HieDebug.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Compat.HieDebug - ( module GHC.Iface.Ext.Debug - , ppHie ) where -import GHC.Iface.Ext.Debug - -import GHC.Iface.Ext.Types (HieAST) -import GHC.Utils.Outputable (Outputable(ppr), SDoc) - -ppHie :: Outputable a => HieAST a -> SDoc -ppHie = ppr diff --git a/hie-compat/src-reexport-ghc9/Compat/HieTypes.hs b/hie-compat/src-reexport-ghc9/Compat/HieTypes.hs deleted file mode 100644 index 36bb86abeb..0000000000 --- a/hie-compat/src-reexport-ghc9/Compat/HieTypes.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieTypes - ( module GHC.Iface.Ext.Types ) where -import GHC.Iface.Ext.Types diff --git a/hie-compat/src-reexport-ghc9/Compat/HieUtils.hs b/hie-compat/src-reexport-ghc9/Compat/HieUtils.hs deleted file mode 100644 index 204a312039..0000000000 --- a/hie-compat/src-reexport-ghc9/Compat/HieUtils.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieUtils - ( module GHC.Iface.Ext.Utils ) where -import GHC.Iface.Ext.Utils diff --git a/hie-compat/src-reexport-ghc92/Compat/HieAst.hs b/hie-compat/src-reexport-ghc92/Compat/HieAst.hs deleted file mode 100644 index 240dc4da49..0000000000 --- a/hie-compat/src-reexport-ghc92/Compat/HieAst.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieAst - ( module GHC.Iface.Ext.Ast ) where -import GHC.Iface.Ext.Ast diff --git a/hie-compat/src-reexport-ghc92/Compat/HieBin.hs b/hie-compat/src-reexport-ghc92/Compat/HieBin.hs deleted file mode 100644 index 254e1db6d3..0000000000 --- a/hie-compat/src-reexport-ghc92/Compat/HieBin.hs +++ /dev/null @@ -1,8 +0,0 @@ -{- -Binary serialization for .hie files. --} - -module Compat.HieBin ( module GHC.Iface.Ext.Binary) -where - -import GHC.Iface.Ext.Binary diff --git a/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs b/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs deleted file mode 100644 index 872da67c2b..0000000000 --- a/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Compat.HieDebug - ( module GHC.Iface.Ext.Debug - , ppHie ) where -import GHC.Iface.Ext.Debug - -import GHC.Iface.Ext.Types (HieAST) -import GHC.Utils.Outputable (Outputable(ppr), SDoc) - -ppHie :: Outputable a => HieAST a -> SDoc -ppHie = ppr diff --git a/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs b/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs deleted file mode 100644 index 36bb86abeb..0000000000 --- a/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieTypes - ( module GHC.Iface.Ext.Types ) where -import GHC.Iface.Ext.Types diff --git a/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs b/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs deleted file mode 100644 index 204a312039..0000000000 --- a/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieUtils - ( module GHC.Iface.Ext.Utils ) where -import GHC.Iface.Ext.Utils diff --git a/hie-compat/src-reexport/Compat/HieDebug.hs b/hie-compat/src-reexport/Compat/HieDebug.hs deleted file mode 100644 index 32da665b6d..0000000000 --- a/hie-compat/src-reexport/Compat/HieDebug.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieDebug - ( module HieDebug ) where -import HieDebug diff --git a/hie-compat/src-reexport/Compat/HieTypes.hs b/hie-compat/src-reexport/Compat/HieTypes.hs deleted file mode 100644 index 7185fb10bd..0000000000 --- a/hie-compat/src-reexport/Compat/HieTypes.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieTypes - ( module HieTypes ) where -import HieTypes diff --git a/hie-compat/src-reexport/Compat/HieUtils.hs b/hie-compat/src-reexport/Compat/HieUtils.hs deleted file mode 100644 index c4c401e269..0000000000 --- a/hie-compat/src-reexport/Compat/HieUtils.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Compat.HieUtils - ( module HieUtils ) where -import HieUtils diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal index 18480293fd..5eccb4d75e 100644 --- a/hls-graph/hls-graph.cabal +++ b/hls-graph/hls-graph.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-graph -version: 2.10.0.0 +version: 2.11.0.0 synopsis: Haskell Language Server internal graph API description: Please see the README on GitHub at diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Key.hs b/hls-graph/src/Development/IDE/Graph/Internal/Key.hs index ba303cdb99..85cebeb110 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Key.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Key.hs @@ -34,6 +34,7 @@ module Development.IDE.Graph.Internal.Key ) where --import Control.Monad.IO.Class () +import Control.Exception (evaluate) import Data.Coerce import Data.Dynamic import qualified Data.HashMap.Strict as Map @@ -85,8 +86,15 @@ newKey k = unsafePerformIO $ do lookupKeyValue :: Key -> KeyValue lookupKeyValue (UnsafeMkKey x) = unsafePerformIO $ do + -- NOTE: + -- The reason for this evaluate is that the x, if not forced yet, is a thunk + -- that forces the atomicModifyIORef' in the creation of the new key. If it + -- isn't forced *before* reading the keyMap, the keyMap will only obtain the new + -- key (x) *after* the IntMap is already copied out of the keyMap reference, + -- i.e. when it is forced for the lookup in the IntMap. + k <- evaluate x GlobalKeyValueMap _ im _ <- readIORef keyMap - pure $! im IM.! x + pure $! im IM.! k {-# NOINLINE lookupKeyValue #-} diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index d543c435c2..bad55992bb 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-plugin-api -version: 2.10.0.0 +version: 2.11.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -60,13 +60,13 @@ library , data-default , dependent-map , dependent-sum >=0.7 - , Diff ^>=0.5 + , Diff ^>=0.5 || ^>=1.0.0 , dlist , extra , filepath , ghc , hashable - , hls-graph == 2.10.0.0 + , hls-graph == 2.11.0.0 , lens , lens-aeson , lsp ^>=2.7 diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index 8ee6110d29..a7350ab344 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -3,7 +3,11 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.ConfigUtils where +module Ide.Plugin.ConfigUtils ( + pluginsToDefaultConfig, + pluginsToVSCodeExtensionSchema, + pluginsCustomConfigToMarkdownTables + ) where import Control.Lens (at, (&), (?~)) import qualified Data.Aeson as A @@ -15,8 +19,15 @@ import qualified Data.Dependent.Sum as DSum import Data.List.Extra (nubOrd) import Data.String (IsString (fromString)) import qualified Data.Text as T +import GHC.TypeLits (symbolVal) import Ide.Plugin.Config -import Ide.Plugin.Properties (toDefaultJSON, +import Ide.Plugin.Properties (KeyNameProxy, MetaData (..), + PluginCustomConfig (..), + PluginCustomConfigParam (..), + Properties (..), + SPropertyKey (..), + SomePropertyKeyWithMetaData (..), + toDefaultJSON, toVSCodeExtensionSchema) import Ide.Types import Language.LSP.Protocol.Message @@ -31,10 +42,10 @@ pluginsToDefaultConfig :: IdePlugins a -> A.Value pluginsToDefaultConfig IdePlugins {..} = -- Use '_Object' and 'at' to get at the "plugin" key -- and actually set it. - A.toJSON defaultConfig & _Object . at "plugin" ?~ elems + A.toJSON defaultConfig & _Object . at "plugin" ?~ pluginSpecificDefaultConfigs where - defaultConfig@Config {} = def - elems = A.object $ mconcat $ singlePlugin <$> ipMap + defaultConfig = def :: Config + pluginSpecificDefaultConfigs = A.object $ mconcat $ singlePlugin <$> ipMap -- Splice genericDefaultConfig and dedicatedDefaultConfig -- Example: -- @@ -48,6 +59,7 @@ pluginsToDefaultConfig IdePlugins {..} = -- } -- } -- } + singlePlugin :: PluginDescriptor ideState -> [A.Pair] singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = let x = genericDefaultConfig <> dedicatedDefaultConfig in [fromString (T.unpack pId) A..= A.object x | not $ null x] @@ -66,8 +78,8 @@ pluginsToDefaultConfig IdePlugins {..} = <> nubOrd (mconcat (handlersToGenericDefaultConfig configInitialGenericConfig <$> handlers)) in case x of - -- if the plugin has only one capability, we produce globalOn instead of the specific one; - -- otherwise we don't produce globalOn at all + -- If the plugin has only one capability, we produce globalOn instead of the specific one; + -- otherwise we omit globalOn [_] -> ["globalOn" A..= plcGlobalOn configInitialGenericConfig] _ -> x -- Example: @@ -139,3 +151,92 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug ] withIdPrefix x = "haskell.plugin." <> pId <> "." <> x toKey' = fromString . T.unpack . withIdPrefix + + +-- | Generates markdown tables for custom config +pluginsCustomConfigToMarkdownTables :: IdePlugins a -> T.Text +pluginsCustomConfigToMarkdownTables IdePlugins {..} = T.unlines + $ map renderCfg + $ filter (\(PluginCustomConfig _ params) -> not $ null params) + $ map toPluginCustomConfig ipMap + where + toPluginCustomConfig :: PluginDescriptor ideState -> PluginCustomConfig + toPluginCustomConfig PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {configCustomConfig = c}, pluginId = PluginId pId} = + PluginCustomConfig { pcc'Name = pId, pcc'Params = toPluginCustomConfigParams c} + toPluginCustomConfigParams :: CustomConfig -> [PluginCustomConfigParam] + toPluginCustomConfigParams (CustomConfig p) = toPluginCustomConfigParams' p + toPluginCustomConfigParams' :: Properties r -> [PluginCustomConfigParam] + toPluginCustomConfigParams' EmptyProperties = [] + toPluginCustomConfigParams' (ConsProperties (keyNameProxy :: KeyNameProxy s) (k :: SPropertyKey k) (m :: MetaData t) xs) = + toEntry (SomePropertyKeyWithMetaData k m) : toPluginCustomConfigParams' xs + where + toEntry :: SomePropertyKeyWithMetaData -> PluginCustomConfigParam + toEntry (SomePropertyKeyWithMetaData SNumber MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SInteger MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SString MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SBoolean MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SObject _) MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = "TODO: nested object", -- T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SArray _) MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = "TODO: Array values", -- T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = map (T.pack . show) enumValues + } + toEntry (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + renderCfg :: PluginCustomConfig -> T.Text + renderCfg (PluginCustomConfig pId pccParams) = + T.unlines (pluginHeader : tableHeader : rows pccParams) + where + pluginHeader = "## " <> pId + tableHeader = + "| Property | Description | Default | Allowed values |" <> "\n" <> + "| --- | --- | --- | --- |" + rows = map renderRow + renderRow PluginCustomConfigParam {..} = + "| `" <> pccp'Name <> "` | " <> pccp'Description <> " | `" <> pccp'Default <> "` | " <> renderEnum pccp'EnumValues <> " |" + renderEnum [] = "   " -- Placeholder to prevent missing cells + renderEnum vs = "
    " <> (T.intercalate " " $ map (\x -> "
  • " <> x <> "
    • ") vs) <> "
" diff --git a/hls-plugin-api/src/Ide/Plugin/Properties.hs b/hls-plugin-api/src/Ide/Plugin/Properties.hs index dda2bb7e33..49a45721b4 100644 --- a/hls-plugin-api/src/Ide/Plugin/Properties.hs +++ b/hls-plugin-api/src/Ide/Plugin/Properties.hs @@ -21,9 +21,10 @@ module Ide.Plugin.Properties MetaData (..), PropertyKey (..), SPropertyKey (..), + SomePropertyKeyWithMetaData (..), KeyNameProxy (..), KeyNamePath (..), - Properties, + Properties(..), HasProperty, HasPropertyByPath, emptyProperties, @@ -42,6 +43,8 @@ module Ide.Plugin.Properties usePropertyByPathEither, usePropertyByPath, (&), + PluginCustomConfig(..), + PluginCustomConfigParam(..), ) where @@ -516,3 +519,15 @@ toVSCodeExtensionSchema' ps = case ps of ] (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) -> map (first Just) $ toVSCodeExtensionSchema' childrenProperties + +data PluginCustomConfig = PluginCustomConfig { + pcc'Name :: T.Text, + pcc'Params :: [PluginCustomConfigParam] +} +data PluginCustomConfigParam = PluginCustomConfigParam { + pccp'Name :: T.Text, + pccp'Description :: T.Text, + pccp'Default :: T.Text, + pccp'EnumValues :: [T.Text] +} + diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index 773f3401b5..084de98534 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-test-utils -version: 2.10.0.0 +version: 2.11.0.0 synopsis: Utilities used in the tests of Haskell Language Server description: Please see the README on GitHub at @@ -43,8 +43,8 @@ library , directory , extra , filepath - , ghcide == 2.10.0.0 - , hls-plugin-api == 2.10.0.0 + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 , lens , lsp , lsp-test ^>=0.17 diff --git a/hls-test-utils/src/Development/IDE/Test/Diagnostic.hs b/hls-test-utils/src/Development/IDE/Test/Diagnostic.hs index e64ab34876..4fa81a2d57 100644 --- a/hls-test-utils/src/Development/IDE/Test/Diagnostic.hs +++ b/hls-test-utils/src/Development/IDE/Test/Diagnostic.hs @@ -69,7 +69,7 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg, mbExpectedCod | ghcVersion >= GHC96 = case (mbExpectedCode, _code d) of (Nothing, _) -> True - (Just expectedCode, Nothing) -> False + (Just _, Nothing) -> False (Just expectedCode, Just actualCode) -> InR expectedCode == actualCode | otherwise = True diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 9a56467f3f..7a2c53ee25 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -2,65 +2,53 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where -import Control.Concurrent.Strict -import Control.DeepSeq import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS -import Data.Hashable import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List -import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe -import Data.Proxy import qualified Data.Text () import qualified Data.Text as T -import qualified Data.Text.Encoding as Encoding -import Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE as D import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph (Key, - alwaysRerun) +import Development.IDE.Graph (Key) import Development.IDE.LSP.HoverDefinition (foundHover) import qualified Development.IDE.Plugin.Completions.Logic as Ghcide import Development.IDE.Types.Shake (toKey) -import qualified Distribution.CabalSpecVersion as Cabal import qualified Distribution.Fields as Syntax import Distribution.Package (Dependency) import Distribution.PackageDescription (allBuildDepends, depPkgName, unPackageName) import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import Distribution.Parsec.Error import qualified Distribution.Parsec.Position as Syntax -import GHC.Generics -import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd +import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd +import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes import qualified Ide.Plugin.Cabal.Completion.Completions as Completions -import qualified Ide.Plugin.Cabal.Completion.Data as Data import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections), ParseCabalFields (..), ParseCabalFile (..)) import qualified Ide.Plugin.Cabal.Completion.Types as Types import Ide.Plugin.Cabal.Definition (gotoDefinition) -import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest +import qualified Ide.Plugin.Cabal.Files as CabalAdd import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest +import qualified Ide.Plugin.Cabal.OfInterest as OfInterest import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline -import qualified Ide.Plugin.Cabal.Parse as Parse +import qualified Ide.Plugin.Cabal.Rules as Rules import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL @@ -71,7 +59,8 @@ import Text.Regex.TDFA data Log = LogModificationTime NormalizedFilePath FileVersion - | LogShake Shake.Log + | LogRule Rules.Log + | LogOfInterest OfInterest.Log | LogDocOpened Uri | LogDocModified Uri | LogDocSaved Uri @@ -84,7 +73,8 @@ data Log instance Pretty Log where pretty = \case - LogShake log' -> pretty log' + LogRule log' -> pretty log' + LogOfInterest log' -> pretty log' LogModificationTime nfp modTime -> "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) LogDocOpened uri -> @@ -105,28 +95,30 @@ instance Pretty Log where LogCompletions logs -> pretty logs LogCabalAdd logs -> pretty logs --- | Some actions with cabal files originate from haskell files. --- This descriptor allows to hook into the diagnostics of haskell source files, and --- allows us to provide code actions and commands that interact with `.cabal` files. +{- | Some actions in cabal files can be triggered from haskell files. +This descriptor allows us to hook into the diagnostics of haskell source files and +allows us to provide code actions and commands that interact with `.cabal` files. +-} haskellInteractionDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState haskellInteractionDescriptor recorder plId = (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files") { pluginHandlers = mconcat - [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction + [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddDependencyCodeAction recorder + , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ cabalAddModuleCodeAction recorder ] - , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)] - , pluginRules = pure () - , pluginNotificationHandlers = mempty + , pluginCommands = + [ PluginCommand CabalAdd.cabalAddDependencyCommandId "add a dependency to a cabal file" (CabalAdd.addDependencyCommand cabalAddRecorder) + , PluginCommand CabalAdd.cabalAddModuleCommandId "add a module to a cabal file" (CabalAdd.addModuleCommand cabalAddRecorder) + ] } - where - cabalAddRecorder = cmapWithPrio LogCabalAdd recorder - + where + cabalAddRecorder = cmapWithPrio LogCabalAdd recorder descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultCabalPluginDescriptor plId "Provides a variety of IDE features in cabal files") - { pluginRules = cabalRules recorder plId + { pluginRules = Rules.cabalRules ruleRecorder plId , pluginHandlers = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction @@ -143,32 +135,35 @@ descriptor recorder plId = whenUriFile _uri $ \file -> do log' Debug $ LogDocOpened _uri restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $ - addFileOfInterest recorder ide file Modified{firstOpen = True} + OfInterest.addFileOfInterest ofInterestRecorder ide file Modified{firstOpen = True} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $ \ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocModified _uri restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $ - addFileOfInterest recorder ide file Modified{firstOpen = False} + OfInterest.addFileOfInterest ofInterestRecorder ide file Modified{firstOpen = False} , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $ \ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocSaved _uri - restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $ - addFileOfInterest recorder ide file OnDisk + restartCabalShakeSessionPhysical (shakeExtras ide) vfs file "(saved)" $ + OfInterest.addFileOfInterest ofInterestRecorder ide file OnDisk , mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $ \ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do log' Debug $ LogDocClosed _uri restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $ - deleteFileOfInterest recorder ide file + OfInterest.deleteFileOfInterest ofInterestRecorder ide file ] - , pluginConfigDescriptor = defaultConfigDescriptor - { configHasDiagnostics = True - } + , pluginConfigDescriptor = + defaultConfigDescriptor + { configHasDiagnostics = True + } } where log' = logWith recorder + ruleRecorder = cmapWithPrio LogRule recorder + ofInterestRecorder = cmapWithPrio LogOfInterest recorder whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath' @@ -188,144 +183,36 @@ restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = d keys <- actionBetweenSession return (toKey GetModificationTime file:keys) --- ---------------------------------------------------------------- --- Plugin Rules --- ---------------------------------------------------------------- - -cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules () -cabalRules recorder plId = do - -- Make sure we initialise the cabal files-of-interest. - ofInterestRules recorder - -- Rule to produce diagnostics for cabal files. - define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do - config <- getPluginConfigAction plId - if not (plcGlobalOn config && plcDiagnosticsOn config) - then pure ([], Nothing) - else do - -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), - -- we rerun this rule because this rule *depends* on GetModificationTime. - (t, mCabalSource) <- use_ GetFileContents file - log' Debug $ LogModificationTime file t - contents <- case mCabalSource of - Just sources -> - pure $ Encoding.encodeUtf8 $ Rope.toText sources - Nothing -> do - liftIO $ BS.readFile $ fromNormalizedFilePath file - - case Parse.readCabalFields file contents of - Left _ -> - pure ([], Nothing) - Right fields -> - pure ([], Just fields) - - define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections file -> do - fields <- use_ ParseCabalFields file - let commonSections = Maybe.mapMaybe (\case - commonSection@(Syntax.Section (Syntax.Name _ "common") _ _) -> Just commonSection - _ -> Nothing) - fields - pure ([], Just commonSections) - - define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do - config <- getPluginConfigAction plId - if not (plcGlobalOn config && plcDiagnosticsOn config) - then pure ([], Nothing) - else do - -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), - -- we rerun this rule because this rule *depends* on GetModificationTime. - (t, mCabalSource) <- use_ GetFileContents file - log' Debug $ LogModificationTime file t - contents <- case mCabalSource of - Just sources -> - pure $ Encoding.encodeUtf8 $ Rope.toText sources - Nothing -> do - liftIO $ BS.readFile $ fromNormalizedFilePath file - - -- Instead of fully reparsing the sources to get a 'GenericPackageDescription', - -- we would much rather re-use the already parsed results of 'ParseCabalFields'. - -- Unfortunately, Cabal-syntax doesn't expose the function 'parseGenericPackageDescription'' - -- which allows us to resume the parsing pipeline with '[Field Position]'. - (pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents - let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings - case pm of - Left (_cabalVersion, pErrorNE) -> do - let regexUnknownCabalBefore310 :: T.Text - -- We don't support the cabal version, this should not be an error, as the - -- user did not do anything wrong. Instead we cast it to a warning - regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*" - regexUnknownCabalVersion :: T.Text - regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+" - unsupportedCabalHelpText = unlines - [ "The used `cabal-version` is not fully supported by this `HLS` binary." - , "Either the `cabal-version` is unknown, or too new for this executable." - , "This means that some functionality might not work as expected." - , "If you face any issues, try downgrading to a supported `cabal-version` or upgrading `HLS` if possible." - , "" - , "Supported versions are: " <> - List.intercalate ", " - (fmap Cabal.showCabalSpecVersion Data.supportedCabalVersions) - ] - errorDiags = - NE.toList $ - NE.map - ( \pe@(PError pos text) -> - if any (text =~) - [ regexUnknownCabalBefore310 - , regexUnknownCabalVersion - ] - then Diagnostics.warningDiagnostic file (Syntax.PWarning Syntax.PWTOther pos $ - unlines - [ text - , unsupportedCabalHelpText - ]) - else Diagnostics.errorDiagnostic file pe - ) - pErrorNE - allDiags = errorDiags <> warningDiags - pure (allDiags, Nothing) - Right gpd -> do - pure (warningDiags, Just gpd) - - action $ do - -- Run the cabal kick. This code always runs when 'shakeRestart' is run. - -- Must be careful to not impede the performance too much. Crucial to - -- a snappy IDE experience. - kick - where - log' = logWith recorder - -{- | This is the kick function for the cabal plugin. -We run this action, whenever we shake session us run/restarted, which triggers -actions to produce diagnostics for cabal files. - -It is paramount that this kick-function can be run quickly, since it is a blocking -function invocation. --} -kick :: Action () -kick = do - files <- HashMap.keys <$> getCabalFilesOfInterestUntracked - Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile +-- | Just like 'restartCabalShakeSession', but records that the 'file' has been changed on disk. +-- So, any action that can only work with on-disk modifications may depend on the 'GetPhysicalModificationTime' +-- rule to get re-run if the file changes on disk. +restartCabalShakeSessionPhysical :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO () +restartCabalShakeSessionPhysical shakeExtras vfs file actionMsg actionBetweenSession = do + restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do + keys <- actionBetweenSession + return (toKey GetModificationTime file:toKey GetPhysicalModificationTime file:keys) -- ---------------------------------------------------------------- -- Code Actions -- ---------------------------------------------------------------- licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = do +licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics = diags}) = do maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri) --- | CodeActions for correcting field names with typos in them. --- --- Provides CodeActions that fix typos in both stanzas and top-level field names. --- The suggestions are computed based on the completion context, where we "move" a fake cursor --- to the end of the field name and trigger cabal file completions. The completions are then --- suggested to the user. --- --- TODO: Relying on completions here often does not produce the desired results, we should --- use some sort of fuzzy matching in the future, see issue #4357. +{- | CodeActions for correcting field names with typos in them. + +Provides CodeActions that fix typos in both stanzas and top-level field names. +The suggestions are computed based on the completion context, where we "move" a fake cursor +to the end of the field name and trigger cabal file completions. The completions are then +suggested to the user. + +TODO: Relying on completions here often does not produce the desired results, we should +use some sort of fuzzy matching in the future, see issue #4357. +-} fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do +fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics = diags}) = do mContents <- liftIO $ runAction "cabal-plugin.getUriContents" ide $ getUriContents $ toNormalizedUri uri case (,) <$> mContents <*> uriToFilePath' uri of Nothing -> pure $ InL [] @@ -340,47 +227,80 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif let fields = Maybe.mapMaybe FieldSuggest.fieldErrorName diags results <- forM fields (getSuggestion fileContents path cabalFields) pure $ InL $ map InR $ concat results - where - getSuggestion fileContents fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do - let -- Compute where we would anticipate the cursor to be. - fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) - lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents - cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo - completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields - let completionTexts = fmap (^. JL.label) completions - pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range - -cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do - maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction - let suggestions = take maxCompls $ concatMap CabalAdd.hiddenPackageSuggestion diags + where + getSuggestion fileContents fp cabalFields (fieldName, Diagnostic{_range = _range@(Range (Position lineNr col) _)}) = do + let + -- Compute where we would anticipate the cursor to be. + fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) + lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents + cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo + completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields + let completionTexts = fmap (^. JL.label) completions + pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range + +cabalAddDependencyCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +cabalAddDependencyCodeAction _ state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics = diags}) = do + let suggestions = concatMap CabalAdd.hiddenPackageSuggestion diags case suggestions of [] -> pure $ InL [] - _ -> - case uriToFilePath uri of + _ -> do + haskellFilePath <- uriToFilePathE uri + mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath + case mbCabalFile of Nothing -> pure $ InL [] - Just haskellFilePath -> do - mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath - case mbCabalFile of + Just cabalFilePath -> do + verTxtDocId <- + runActionE "cabalAdd.getVersionedTextDoc" state $ + lift $ + getVersionedTextDoc $ + TextDocumentIdentifier (filePathToUri cabalFilePath) + mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + case mbGPD of Nothing -> pure $ InL [] - Just cabalFilePath -> do - verTxtDocId <- runActionE "cabalAdd.getVersionedTextDoc" state $ - lift $ getVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath) - mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath - case mbGPD of - Nothing -> pure $ InL [] - Just (gpd, _) -> do - actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction plId verTxtDocId - suggestions - haskellFilePath cabalFilePath - gpd - pure $ InL $ fmap InR actions + Just (gpd, _) -> do + actions <- + liftIO $ + CabalAdd.addDependencySuggestCodeAction + plId + verTxtDocId + suggestions + haskellFilePath + cabalFilePath + gpd + pure $ InL $ fmap InR actions + +cabalAddModuleCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +cabalAddModuleCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics = diags}) = + case List.find CabalAdd.isUnknownModuleDiagnostic diags of + Just diag -> + do + haskellFilePath <- uriToFilePathE uri + mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath + case mbCabalFile of + Nothing -> pure $ InL [] + Just cabalFilePath -> do + verTextDocId <- + runActionE "cabalAdd.getVersionedTextDoc" state $ + lift $ + getVersionedTextDoc $ + TextDocumentIdentifier (filePathToUri cabalFilePath) + (gpd, _) <- runActionE "cabal.cabal-add" state $ useWithStaleE ParseCabalFile $ toNormalizedFilePath cabalFilePath + actions <- + CabalAdd.collectModuleInsertionOptions + (cmapWithPrio LogCabalAdd recorder) + plId + verTextDocId + diag + cabalFilePath + gpd + uri + pure $ InL $ fmap InR actions + Nothing -> pure $ InL [] + +{- | Handler for hover messages. --- | Handler for hover messages. --- --- Provides a Handler for displaying message on hover. --- If found that the filtered hover message is a dependency, --- adds a Documentation link. +If the cursor is hovering on a dependency, add a documentation link to that dependency. +-} hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover hover ide _ msgParam = do nfp <- getNormalizedFilePathE uri @@ -395,111 +315,35 @@ hover ide _ msgParam = do Nothing -> pure $ InR Null Just txt -> if txt `elem` depsNames - then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt]) - else pure $ InR Null - where - cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) - uri = msgParam ^. JL.textDocument . JL.uri - - dependencyName :: Dependency -> T.Text - dependencyName dep = T.pack $ unPackageName $ depPkgName dep - - -- | Removes version requirements like - -- `==1.0.0.0`, `>= 2.1.1` that could be included in - -- hover message. Assumes that the dependency consists - -- of alphanums with dashes in between. Ends with an alphanum. - -- - -- Examples: - -- >>> filterVersion "imp-deps>=2.1.1" - -- "imp-deps" - filterVersion :: T.Text -> Maybe T.Text - filterVersion msg = getMatch (msg =~ regex) - where - regex :: T.Text - regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])" - - getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text - getMatch (_, _, _, [dependency]) = Just dependency - getMatch (_, _, _, _) = Nothing -- impossible case - - documentationText :: T.Text -> T.Text - documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" - - --- ---------------------------------------------------------------- --- Cabal file of Interest rules and global variable --- ---------------------------------------------------------------- - -{- | Cabal files that are currently open in the lsp-client. -Specific actions happen when these files are saved, closed or modified, -such as generating diagnostics, re-parsing, etc... - -We need to store the open files to parse them again if we restart the shake session. -Restarting of the shake session happens whenever these files are modified. --} -newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) - -instance Shake.IsIdeGlobal OfInterestCabalVar - -data IsCabalFileOfInterest = IsCabalFileOfInterest - deriving (Eq, Show, Generic) -instance Hashable IsCabalFileOfInterest -instance NFData IsCabalFileOfInterest - -type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult - -data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus - deriving (Eq, Show, Generic) -instance Hashable CabalFileOfInterestResult -instance NFData CabalFileOfInterestResult - -{- | The rule that initialises the files of interest state. - -Needs to be run on start-up. --} -ofInterestRules :: Recorder (WithPriority Log) -> Rules () -ofInterestRules recorder = do - Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty) - Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do - alwaysRerun - filesOfInterest <- getCabalFilesOfInterestUntracked - let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest - fp = summarize foi - res = (Just fp, Just foi) - return res + then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt]) + else pure $ InR Null where - summarize NotCabalFOI = BS.singleton 0 - summarize (IsCabalFOI OnDisk) = BS.singleton 1 - summarize (IsCabalFOI (Modified False)) = BS.singleton 2 - summarize (IsCabalFOI (Modified True)) = BS.singleton 3 - -getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) -getCabalFilesOfInterestUntracked = do - OfInterestCabalVar var <- Shake.getIdeGlobalAction - liftIO $ readVar var - -addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] -addFileOfInterest recorder state f v = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - (prev, files) <- modifyVar var $ \dict -> do - let (prev, new) = HashMap.alterF (,Just v) f dict - pure (new, (prev, new)) - if prev /= Just v - then do - log' Debug $ LogFOI files - return [toKey IsCabalFileOfInterest f] - else return [] - where - log' = logWith recorder - -deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key] -deleteFileOfInterest recorder state f = do - OfInterestCabalVar var <- Shake.getIdeGlobalState state - files <- modifyVar' var $ HashMap.delete f - log' Debug $ LogFOI files - return [toKey IsFileOfInterest f] - where - log' = logWith recorder + cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) + uri = msgParam ^. JL.textDocument . JL.uri + + dependencyName :: Dependency -> T.Text + dependencyName dep = T.pack $ unPackageName $ depPkgName dep + + -- \| Removes version requirements like + -- `==1.0.0.0`, `>= 2.1.1` that could be included in + -- hover message. Assumes that the dependency consists + -- of alphanums with dashes in between. Ends with an alphanum. + -- + -- Examples: + -- >>> filterVersion "imp-deps>=2.1.1" + -- "imp-deps" + filterVersion :: T.Text -> Maybe T.Text + filterVersion msg = getMatch (msg =~ regex) + where + regex :: T.Text + regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])" + + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text + getMatch (_, _, _, [dependency]) = Just dependency + getMatch (_, _, _, _) = Nothing -- impossible case + + documentationText :: T.Text -> T.Text + documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" -- ---------------------------------------------------------------- -- Completion @@ -532,23 +376,24 @@ computeCompletionsAt recorder ide prefInfo fp fields = do Just ctx -> do logWith recorder Debug $ LogCompletionContext ctx pos let completer = Completions.contextToCompleter ctx - let completerData = CompleterTypes.CompleterData - { getLatestGPD = do - -- We decide on useWithStaleFast here, since we mostly care about the file's meta information, - -- thus, a quick response gives us the desired result most of the time. - -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. - mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp - pure $ fmap fst mGPD - , getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp - , cabalPrefixInfo = prefInfo - , stanzaName = - case fst ctx of - Types.Stanza _ name -> name - _ -> Nothing - } + let completerData = + CompleterTypes.CompleterData + { getLatestGPD = do + -- We decide on useWithStaleFast here, since we mostly care about the file's meta information, + -- thus, a quick response gives us the desired result most of the time. + -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. + mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp + pure $ fmap fst mGPD + , getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp + , cabalPrefixInfo = prefInfo + , stanzaName = + case fst ctx of + Types.Stanza _ name -> name + _ -> Nothing + } completions <- completer completerRecorder completerData pure completions - where - pos = Types.completionCursorPosition prefInfo - context fields = Completions.getContext completerRecorder prefInfo fields - completerRecorder = cmapWithPrio LogCompletions recorder + where + pos = Types.completionCursorPosition prefInfo + context fields = Completions.getContext completerRecorder prefInfo fields + completerRecorder = cmapWithPrio LogCompletions recorder diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs deleted file mode 100644 index 3b46eec128..0000000000 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs +++ /dev/null @@ -1,326 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE RecordWildCards #-} - -module Ide.Plugin.Cabal.CabalAdd -( findResponsibleCabalFile - , addDependencySuggestCodeAction - , hiddenPackageSuggestion - , cabalAddCommand - , command - , Log -) -where - -import Control.Monad (filterM, void) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except -import Data.Aeson.Types (FromJSON, - ToJSON, toJSON) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as B -import Data.List.NonEmpty (NonEmpty (..), - fromList) -import Data.String (IsString) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text.Encoding as T -import Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE (IdeState, - getFileContents, - useWithStale) -import Development.IDE.Core.Rules (runAction) -import Distribution.Client.Add as Add -import Distribution.Compat.Prelude (Generic) -import Distribution.PackageDescription (GenericPackageDescription, - packageDescription, - specVersion) -import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import Distribution.PackageDescription.Quirks (patchQuirks) -import qualified Distribution.Pretty as Pretty -import Distribution.Simple.BuildTarget (BuildTarget, - buildTargetComponentName, - readBuildTargets) -import Distribution.Simple.Utils (safeHead) -import Distribution.Verbosity (silent, - verboseNoStderr) -import Ide.Logger -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), - ParseCabalFile (..)) -import Ide.Plugin.Cabal.Orphans () -import Ide.Plugin.Error -import Ide.PluginUtils (WithDeletions (SkipDeletions), - diffText, - mkLspCommand) -import Ide.Types (CommandFunction, - CommandId (CommandId), - PluginId, - pluginGetClientCapabilities, - pluginSendRequest) -import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) -import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), - ClientCapabilities, - CodeAction (CodeAction), - CodeActionKind (CodeActionKind_QuickFix), - Diagnostic (..), - Null (Null), - VersionedTextDocumentIdentifier, - WorkspaceEdit, - toNormalizedFilePath, - type (|?) (InR)) -import System.Directory (doesFileExist, - listDirectory) -import System.FilePath (dropFileName, - makeRelative, - splitPath, - takeExtension, - ()) -import Text.PrettyPrint (render) -import Text.Regex.TDFA - -data Log - = LogFoundResponsibleCabalFile FilePath - | LogCalledCabalAddCommand CabalAddCommandParams - | LogCreatedEdit WorkspaceEdit - | LogExecutedCommand - deriving (Show) - -instance Pretty Log where - pretty = \case - LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " <+> pretty fp - LogCalledCabalAddCommand params -> "Called CabalAdd command with:\n" <+> pretty params - LogCreatedEdit edit -> "Created inplace edit:\n" <+> pretty edit - LogExecutedCommand -> "Executed CabalAdd command" - -cabalAddCommand :: IsString p => p -cabalAddCommand = "cabalAdd" - -data CabalAddCommandParams = - CabalAddCommandParams { cabalPath :: FilePath - , verTxtDocId :: VersionedTextDocumentIdentifier - , buildTarget :: Maybe String - , dependency :: T.Text - , version :: Maybe T.Text - } - deriving (Generic, Show) - deriving anyclass (FromJSON, ToJSON) - -instance Pretty CabalAddCommandParams where - pretty CabalAddCommandParams{..} = - "CabalAdd parameters:" <+> vcat - [ "cabal path:" <+> pretty cabalPath - , "target:" <+> pretty buildTarget - , "dependendency:" <+> pretty dependency - , "version:" <+> pretty version - ] - --- | Creates a code action that calls the `cabalAddCommand`, --- using dependency-version suggestion pairs as input. --- --- Returns disabled action if no cabal files given. --- --- Takes haskell file and cabal file paths to create a relative path --- to the haskell file, which is used to get a `BuildTarget`. --- --- In current implementation the dependency is being added to the main found --- build target, but if there will be a way to get all build targets from a file --- it will be possible to support addition to a build target of choice. -addDependencySuggestCodeAction - :: PluginId - -> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier - -> [(T.Text, T.Text)] -- ^ A dependency-version suggestion pairs - -> FilePath -- ^ Path to the haskell file (source of diagnostics) - -> FilePath -- ^ Path to the cabal file (that will be edited) - -> GenericPackageDescription - -> IO [CodeAction] -addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do - buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath - case buildTargets of - -- If there are no build targets found, run `cabal-add` command with default behaviour - [] -> pure $ mkCodeAction cabalFilePath Nothing <$> suggestions - -- Otherwise provide actions for all found targets - targets -> pure $ concat [mkCodeAction cabalFilePath (Just $ buildTargetToStringRepr target) <$> - suggestions | target <- targets] - where - -- | Note the use of `pretty` function. - -- It converts the `BuildTarget` to an acceptable string representation. - -- It will be used in as the input for `cabal-add`'s `executeConfig`. - buildTargetToStringRepr target = render $ Pretty.pretty $ buildTargetComponentName target - - -- | Gives the build targets that are used in the `CabalAdd`. - -- Note the unorthodox usage of `readBuildTargets`: - -- If the relative path to the haskell file is provided, - -- the `readBuildTargets` will return build targets, where this - -- module is mentioned (in exposed-modules or other-modules). - getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] - getBuildTargets gpd cabalFilePath haskellFilePath = do - let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath - readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] - - mkCodeAction :: FilePath -> Maybe String -> (T.Text, T.Text) -> CodeAction - mkCodeAction cabalFilePath target (suggestedDep, suggestedVersion) = - let - versionTitle = if T.null suggestedVersion then T.empty else "-" <> suggestedVersion - targetTitle = case target of - Nothing -> T.empty - Just t -> " at " <> T.pack t - title = "Add dependency " <> suggestedDep <> versionTitle <> targetTitle - version = if T.null suggestedVersion then Nothing else Just suggestedVersion - - params = CabalAddCommandParams {cabalPath = cabalFilePath - , verTxtDocId = verTxtDocId - , buildTarget = target - , dependency = suggestedDep - , version=version} - command = mkLspCommand plId (CommandId cabalAddCommand) "Add missing dependency" (Just [toJSON params]) - in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing - --- | Gives a mentioned number of @(dependency, version)@ pairs --- found in the "hidden package" diagnostic message. --- --- For example, if a ghc error looks like this: --- --- > "Could not load module ‘Data.List.Split’ --- > It is a member of the hidden package ‘split-0.2.5’. --- > Perhaps you need to add ‘split’ to the build-depends in your .cabal file." --- --- or this if PackageImports extension is used: --- --- > "Could not find module ‘Data.List.Split’ --- > Perhaps you meant --- > Data.List.Split (needs flag -package-id split-0.2.5)" --- --- It extracts mentioned package names and version numbers. --- In this example, it will be @[("split", "0.2.5")]@ --- --- Also supports messages without a version. --- --- > "Perhaps you need to add ‘split’ to the build-depends in your .cabal file." --- --- Will turn into @[("split", "")]@ -hiddenPackageSuggestion :: Diagnostic -> [(T.Text, T.Text)] -hiddenPackageSuggestion diag = getMatch (msg =~ regex) - where - msg :: T.Text - msg = _message diag - regex :: T.Text -- TODO: Support multiple packages suggestion - regex = - let regex' = "([a-zA-Z0-9-]*[a-zA-Z0-9])(-([0-9\\.]*))?" - in "It is a member of the hidden package [\8216']" <> regex' <> "[\8217']" - <> "|" - <> "needs flag -package-id " <> regex' - -- Have to do this matching because `Regex.TDFA` doesn't(?) support - -- not-capturing groups like (?:message) - getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] - getMatch (_, _, _, []) = [] - getMatch (_, _, _, [dependency, _, cleanVersion, "", "", ""]) = [(dependency, cleanVersion)] - getMatch (_, _, _, ["", "", "", dependency, _, cleanVersion]) = [(dependency, cleanVersion)] - getMatch (_, _, _, _) = [] - -command :: Recorder (WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams -command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do - logWith recorder Debug $ LogCalledCabalAddCommand params - let specifiedDep = case mbVer of - Nothing -> dep - Just ver -> dep <> " ^>=" <> ver - caps <- lift pluginGetClientCapabilities - let env = (state, caps, verTxtDocId) - edit <- getDependencyEdit recorder env path target (fromList [T.unpack specifiedDep]) - void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - logWith recorder Debug LogExecutedCommand - pure $ InR Null - --- | Constructs prerequisites for the @executeConfig@ --- and runs it, given path to the cabal file and a dependency message. --- Given the new contents of the cabal file constructs and returns the @edit@. --- Inspired by @main@ in cabal-add, --- Distribution.Client.Main -getDependencyEdit :: MonadIO m => Recorder (WithPriority Log) -> (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> - FilePath -> Maybe String -> NonEmpty String -> ExceptT PluginError m WorkspaceEdit -getDependencyEdit recorder env cabalFilePath buildTarget dependency = do - let (state, caps, verTxtDocId) = env - (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do - contents <- getFileContents $ toNormalizedFilePath cabalFilePath - inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath - inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath - let mbCnfOrigContents = case contents of - (Just txt) -> Just $ encodeUtf8 $ Rope.toText txt - _ -> Nothing - let mbFields = fst <$> inFields - let mbPackDescr = fst <$> inPackDescr - pure (mbCnfOrigContents, mbFields, mbPackDescr) - - -- Check if required info was received, - -- otherwise fall back on other options. - (cnfOrigContents, fields, packDescr) <- do - cnfOrigContents <- case mbCnfOrigContents of - (Just cnfOrigContents) -> pure cnfOrigContents - Nothing -> readCabalFile cabalFilePath - (fields, packDescr) <- case (mbFields, mbPackDescr) of - (Just fields, Just packDescr) -> pure (fields, packDescr) - (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of - Left err -> throwE $ PluginInternalError $ T.pack err - Right (f ,gpd) -> pure (f, gpd) - pure (cnfOrigContents, fields, packDescr) - - let inputs = do - let rcnfComponent = buildTarget - let specVer = specVersion $ packageDescription packDescr - cmp <- resolveComponent cabalFilePath (fields, packDescr) rcnfComponent - deps <- traverse (validateDependency specVer) dependency - pure (fields, packDescr, cmp, deps) - - (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of - Left err -> throwE $ PluginInternalError $ T.pack err - Right pair -> pure pair - - case executeConfig (validateChanges origPackDescr) (Config {..}) of - Nothing -> throwE $ PluginInternalError $ T.pack $ "Cannot extend build-depends in " ++ cabalFilePath - Just newContents -> do - let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions - logWith recorder Debug $ LogCreatedEdit edit - pure edit - --- | Given a path to a haskell file, returns the closest cabal file. --- If a package.yaml is present in same directory as the .cabal file, returns nothing, because adding a dependency to a generated cabal file --- will break propagation of changes from package.yaml to cabal files in stack projects. --- If cabal file wasn't found, gives Nothing. -findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) -findResponsibleCabalFile haskellFilePath = do - let dirPath = dropFileName haskellFilePath - allDirPaths = reverse $ scanl1 () (splitPath dirPath) -- sorted from most to least specific - go allDirPaths - where - go [] = pure Nothing - go (path:ps) = do - objects <- listDirectory path - let objectsWithPaths = map (\obj -> path <> obj) objects - objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths - cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension - case safeHead cabalFiles of - Nothing -> go ps - Just cabalFile -> guardAgainstHpack path cabalFile - where - guardAgainstHpack :: FilePath -> FilePath -> IO (Maybe FilePath) - guardAgainstHpack path cabalFile = do - exists <- doesFileExist $ path "package.yaml" - if exists then pure Nothing else pure $ Just cabalFile - --- | Gives cabal file's contents or throws error. --- Inspired by @readCabalFile@ in cabal-add, --- Distribution.Client.Main --- --- This is a fallback option! --- Use only if the `GetFileContents` fails. -readCabalFile :: MonadIO m => FilePath -> ExceptT PluginError m ByteString -readCabalFile fileName = do - cabalFileExists <- liftIO $ doesFileExist fileName - if cabalFileExists - then snd . patchQuirks <$> liftIO (B.readFile fileName) - else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs new file mode 100644 index 0000000000..d72ad290fd --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs @@ -0,0 +1,343 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} + +module Ide.Plugin.Cabal.CabalAdd.CodeAction where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Except +import Data.Aeson.Types (toJSON) +import Data.Foldable (asum) +import Data.Maybe (mapMaybe) +import qualified Data.Text as T +import Development.IDE.Core.PluginUtils (uriToFilePathE) +import Development.IDE.Types.Location (Uri) +import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import qualified Distribution.Pretty as CabalPretty +import Distribution.Simple.BuildTarget (BuildTarget, + buildTargetComponentName, + readBuildTargets) +import Distribution.Utils.Path (getSymbolicPath) +import Distribution.Verbosity (silent, + verboseNoStderr) +import Ide.Logger +import Ide.Plugin.Cabal.CabalAdd.Types +import Ide.Plugin.Cabal.Completion.Completer.Module (fpToExposedModulePath) +import Ide.Plugin.Cabal.Orphans () +import Ide.Plugin.Error +import Ide.PluginUtils (mkLspCommand) +import Ide.Types (CommandId (CommandId), + PluginId) + +import Control.Lens ((^.)) +import qualified Language.LSP.Protocol.Lens as JL +import Language.LSP.Protocol.Types (CodeActionKind (..), + VersionedTextDocumentIdentifier) +import qualified Language.LSP.Protocol.Types as J +import System.FilePath +import Text.PrettyPrint (render) +import Text.Regex.TDFA + +-------------------------------------------- +-- Add module to cabal file +-------------------------------------------- + +{- | Takes a path to a cabal file, a module path in exposed module syntax + and the contents of the cabal file and generates all possible + code actions for inserting the module into the cabal file + with the given contents. +-} +collectModuleInsertionOptions :: + (MonadIO m) => + Recorder (WithPriority Log) -> + PluginId -> + VersionedTextDocumentIdentifier -> + J.Diagnostic -> + -- | The file path of the cabal file to insert the new module into + FilePath -> + -- | The generic package description of the cabal file to insert the new module into. + GenericPackageDescription -> + -- | The URI of the unknown haskell file/new module to insert into the cabal file. + Uri -> + ExceptT PluginError m [J.CodeAction] +collectModuleInsertionOptions _ plId txtDocIdentifier diag cabalFilePath gpd haskellFilePathURI = do + haskellFilePath <- uriToFilePathE haskellFilePathURI + let configs = concatMap (mkModuleInsertionConfig txtDocIdentifier cabalFilePath haskellFilePath) (makeStanzaItems gpd) + pure $ map (mkCodeActionForModulePath plId diag) configs + where + makeStanzaItems :: GenericPackageDescription -> [StanzaItem] + makeStanzaItems gpd = + mainLibItem pd + ++ libItems pd + ++ executableItems pd + ++ testSuiteItems pd + ++ benchmarkItems pd + where + pd = flattenPackageDescription gpd + +{- | Takes a buildInfo of a cabal file component as defined in the generic package description, + and translates it to filepaths of the component's hsSourceDirs, + to be processed for adding modules to exposed-, or other-modules fields in a cabal file. +-} +buildInfoToHsSourceDirs :: BuildInfo -> [FilePath] +buildInfoToHsSourceDirs buildInfo = map getSymbolicPath hsSourceDirs' + where + hsSourceDirs' = hsSourceDirs buildInfo + +{- | Takes the path to the cabal file to insert the module into, + the module path to be inserted, and a stanza representation. + + Returns a list of module insertion configs, where each config + represents a possible place to insert the module. +-} +mkModuleInsertionConfig :: VersionedTextDocumentIdentifier -> FilePath -> FilePath -> StanzaItem -> [ModuleInsertionConfig] +mkModuleInsertionConfig txtDocIdentifier cabalFilePath haskellFilePath (StanzaItem{..}) = do + case mkRelativeModulePathM siHsSourceDirs cabalFilePath haskellFilePath of + Just processedModPath -> + [modInsertItem processedModPath "other-modules"] + ++ [modInsertItem processedModPath "exposed-modules" | CLibName _ <- [siComponent]] + _ -> [] + where + modInsertItem :: T.Text -> T.Text -> ModuleInsertionConfig + modInsertItem modPath label = + ModuleInsertionConfig + { targetFile = cabalFilePath + , moduleToInsert = modPath + , modVerTxtDocId = txtDocIdentifier + , insertionStanza = siComponent + , insertionLabel = label + } + +mkCodeActionForModulePath :: PluginId -> J.Diagnostic -> ModuleInsertionConfig -> J.CodeAction +mkCodeActionForModulePath plId diag insertionConfig = + J.CodeAction + { _title = "Add to " <> label <> " as " <> fieldName + , _kind = Just CodeActionKind_Refactor + , _diagnostics = Just [diag] + , _isPreferred = Nothing + , _disabled = Nothing + , _edit = Nothing + , _command = Just command + , _data_ = Nothing + } + where + fieldName = insertionLabel insertionConfig + command = mkLspCommand plId (CommandId cabalAddModuleCommandId) "Add missing module" (Just [toJSON insertionConfig]) + label = T.pack $ CabalPretty.prettyShow $ insertionStanza insertionConfig + +{- | Takes a list of source subdirectories, a cabal source path and a haskell filepath + and returns a path to the module in exposed module syntax. + The path will be relative to one of the subdirectories, in case the module is contained within one of them. +-} +mkRelativeModulePathM :: [FilePath] -> FilePath -> FilePath -> Maybe T.Text +mkRelativeModulePathM hsSourceDirs cabalSrcPath' haskellFilePath = + asum $ + map + ( \srcDir -> do + let relMP = makeRelative (normalise (cabalSrcPath srcDir)) haskellFilePath + if relMP == haskellFilePath then Nothing else Just $ fpToExposedModulePath cabalSrcPath relMP + ) + hsSourceDirs + where + cabalSrcPath = takeDirectory cabalSrcPath' + +isUnknownModuleDiagnostic :: J.Diagnostic -> Bool +isUnknownModuleDiagnostic diag = (msg =~ regex) + where + msg :: T.Text + msg = diag ^. JL.message + regex :: T.Text + regex = "Loading the module [\8216'][^\8217']*[\8217'] failed." + +-------------------------- +-- Below are several utility functions which create a StanzaItem for each of the possible Stanzas, +-- these all have specific constructors we need to match, so we can't generalise this process well. +-------------------------- + +benchmarkItems :: PackageDescription -> [StanzaItem] +benchmarkItems pd = + map + ( \benchmark -> + StanzaItem + { siComponent = CBenchName $ benchmarkName benchmark + , siHsSourceDirs = buildInfoToHsSourceDirs $ benchmarkBuildInfo benchmark + } + ) + (benchmarks pd) + +testSuiteItems :: PackageDescription -> [StanzaItem] +testSuiteItems pd = + map + ( \testSuite -> + StanzaItem + { siComponent = CTestName $ testName testSuite + , siHsSourceDirs = buildInfoToHsSourceDirs $ testBuildInfo testSuite + } + ) + (testSuites pd) + +executableItems :: PackageDescription -> [StanzaItem] +executableItems pd = + map + ( \executable -> + StanzaItem + { siComponent = CExeName $ exeName executable + , siHsSourceDirs = buildInfoToHsSourceDirs $ buildInfo executable + } + ) + (executables pd) + +libItems :: PackageDescription -> [StanzaItem] +libItems pd = + mapMaybe + ( \subLib -> + case libName subLib of + LSubLibName compName -> + Just + StanzaItem + { siComponent = CLibName $ LSubLibName compName + , siHsSourceDirs = buildInfoToHsSourceDirs $ libBuildInfo subLib + } + _ -> Nothing + ) + (subLibraries pd) + +mainLibItem :: PackageDescription -> [StanzaItem] +mainLibItem pd = + case library pd of + Just lib -> + [ StanzaItem + { siComponent = CLibName LMainLibName + , siHsSourceDirs = buildInfoToHsSourceDirs $ libBuildInfo lib + } + ] + Nothing -> [] + +-------------------------------------------- +-- Add dependency to a cabal file +-------------------------------------------- + +{- | Creates a code action that calls the `cabalAddCommand`, + using dependency-version suggestion pairs as input. + + Returns disabled action if no cabal files given. + + Takes haskell and cabal file paths to create a relative path + to the haskell file, which is used to get a `BuildTarget`. +-} +addDependencySuggestCodeAction :: + PluginId -> + -- | Cabal's versioned text identifier + VersionedTextDocumentIdentifier -> + -- | A dependency-version suggestion pairs + [(T.Text, T.Text)] -> + -- | Path to the haskell file (source of diagnostics) + FilePath -> + -- | Path to the cabal file (that will be edited) + FilePath -> + GenericPackageDescription -> + IO [J.CodeAction] +addDependencySuggestCodeAction plId verTxtDocId suggestions haskellFilePath cabalFilePath gpd = do + buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath + case buildTargets of + -- If there are no build targets found, run the `cabal-add` command with default behaviour + [] -> pure $ mkCodeActionForDependency cabalFilePath Nothing <$> suggestions + -- Otherwise provide actions for all found targets + targets -> + pure $ + concat + [ mkCodeActionForDependency cabalFilePath (Just $ buildTargetToStringRepr target) + <$> suggestions + | target <- targets + ] + where + {- | Note the use of the `pretty` function. + It converts the `BuildTarget` to an acceptable string representation. + It will be used as the input for `cabal-add`'s `executeConfig`. + -} + buildTargetToStringRepr target = render $ CabalPretty.pretty $ buildTargetComponentName target + + {- | Finds the build targets that are used in `cabal-add`. + Note the unorthodox usage of `readBuildTargets`: + If the relative path to the haskell file is provided, + `readBuildTargets` will return the build targets, this + module is mentioned in (either exposed-modules or other-modules). + -} + getBuildTargets :: GenericPackageDescription -> FilePath -> FilePath -> IO [BuildTarget] + getBuildTargets gpd cabalFilePath haskellFilePath = do + let haskellFileRelativePath = makeRelative (dropFileName cabalFilePath) haskellFilePath + readBuildTargets (verboseNoStderr silent) (flattenPackageDescription gpd) [haskellFileRelativePath] + + mkCodeActionForDependency :: FilePath -> Maybe String -> (T.Text, T.Text) -> J.CodeAction + mkCodeActionForDependency cabalFilePath target (suggestedDep, suggestedVersion) = + let + versionTitle = if T.null suggestedVersion then T.empty else "-" <> suggestedVersion + targetTitle = case target of + Nothing -> T.empty + Just t -> " at " <> T.pack t + title = "Add dependency " <> suggestedDep <> versionTitle <> targetTitle + version = if T.null suggestedVersion then Nothing else Just suggestedVersion + + params = + CabalAddDependencyCommandParams + { depCabalPath = cabalFilePath + , depVerTxtDocId = verTxtDocId + , depBuildTarget = target + , depDependency = suggestedDep + , depVersion = version + } + command = mkLspCommand plId (CommandId cabalAddDependencyCommandId) "Add dependency" (Just [toJSON params]) + in + J.CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing + +{- | Gives a mentioned number of @(dependency, version)@ pairs +found in the "hidden package" diagnostic message. + +For example, if a ghc error looks like this: + +> "Could not load module ‘Data.List.Split’ +> It is a member of the hidden package ‘split-0.2.5’. +> Perhaps you need to add ‘split’ to the build-depends in your .cabal file." + +or this if PackageImports extension is used: + +> "Could not find module ‘Data.List.Split’ +> Perhaps you meant +> Data.List.Split (needs flag -package-id split-0.2.5)" + +It extracts mentioned package names and version numbers. +In this example, it will be @[("split", "0.2.5")]@ + +Also supports messages without a version. + +> "Perhaps you need to add ‘split’ to the build-depends in your .cabal file." + +Will turn into @[("split", "")]@ +-} +hiddenPackageSuggestion :: J.Diagnostic -> [(T.Text, T.Text)] +hiddenPackageSuggestion diag = getMatch (msg =~ regex) + where + msg :: T.Text + msg = diag ^. JL.message + regex :: T.Text + regex = + let regex' = "([a-zA-Z0-9-]*[a-zA-Z0-9])(-([0-9\\.]*))?" + in "It is a member of the hidden package [\8216']" + <> regex' + <> "[\8217']" + <> "|" + <> "needs flag -package-id " + <> regex' + -- Have to do this matching because `Regex.TDFA` doesn't(?) support + -- not-capturing groups like (?:message) + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [(T.Text, T.Text)] + getMatch (_, _, _, []) = [] + getMatch (_, _, _, [dependency, _, cleanVersion, "", "", ""]) = [(dependency, cleanVersion)] + getMatch (_, _, _, ["", "", "", dependency, _, cleanVersion]) = [(dependency, cleanVersion)] + getMatch (_, _, _, _) = [] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Command.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Command.hs new file mode 100644 index 0000000000..83554c6a82 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Command.hs @@ -0,0 +1,232 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} + +module Ide.Plugin.Cabal.CabalAdd.Command ( + cabalAddDependencyCommandId, + cabalAddModuleCommandId, + addDependencyCommand, + addModuleCommand, + Log, +) +where + +import Control.Monad (void) +import Control.Monad.Except (modifyError) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.List.NonEmpty (singleton) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text.Encoding as T +import Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE.Core.FileStore (getFileContents) +import Development.IDE.Core.Rules (IdeState) +import Development.IDE.Core.Service (runAction) +import Development.IDE.Core.Shake (useWithStale) +import Distribution.Client.Add as Add +import Distribution.Fields (Field) +import Distribution.PackageDescription +import Distribution.Parsec.Position (Position) +import qualified Distribution.Pretty as CabalPretty +import Ide.Logger +import Ide.Plugin.Cabal.CabalAdd.Types +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), + ParseCabalFile (..)) +import Ide.Plugin.Cabal.Files +import Ide.Plugin.Cabal.Orphans () +import Ide.Plugin.Error +import Ide.PluginUtils (WithDeletions (SkipDeletions), + diffText) +import Ide.Types (CommandFunction, + pluginGetClientCapabilities, + pluginSendRequest) +import Language.LSP.Protocol.Message (SMethod (SMethod_WorkspaceApplyEdit)) +import Language.LSP.Protocol.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), + ClientCapabilities, + Null (Null), + VersionedTextDocumentIdentifier, + WorkspaceEdit, + toNormalizedFilePath, + type (|?) (InR)) + +-------------------------------------------- +-- Add module to cabal file +-------------------------------------------- + +addModuleCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState ModuleInsertionConfig +addModuleCommand recorder state _ params@(ModuleInsertionConfig{..}) = do + logWith recorder Debug $ LogCalledCabalAddModuleCommand params + caps <- lift pluginGetClientCapabilities + let env = (state, caps, modVerTxtDocId) + edit <- getModuleEdit recorder env targetFile insertionStanza (T.unpack insertionLabel) (T.unpack moduleToInsert) + void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) + logWith recorder Debug LogExecutedCommand + pure $ InR Null + +{- | Constructs prerequisites for the @executeConfig@ + and runs it, given path to the cabal file and a dependency message. + Given the new contents of the cabal file constructs and returns the @edit@. + + Inspired by @main@ in cabal-add, Distribution.Client.Main +-} +getModuleEdit :: + forall m. + (MonadIO m) => + Recorder (WithPriority Log) -> + (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> + -- | The cabal file to edit. + FilePath -> + -- | The component to add the module to. + ComponentName -> + -- | The specific field in the component to add the module to. + String -> + -- | The module to add. + String -> + ExceptT PluginError m WorkspaceEdit +getModuleEdit recorder env cabalFilePath stanza targetFieldStr modulePath = + mkCabalAddConfig + recorder + env + cabalFilePath + mkConfig + where + mkConfig :: (ByteString -> [Field Position] -> GenericPackageDescription -> ExceptT PluginError m AddConfig) + mkConfig cnfOrigContents fields packDescr = do + compName <- + case Add.resolveComponent cabalFilePath (fields, packDescr) $ Just $ CabalPretty.prettyShow stanza of + Right x -> pure x + Left err -> do + logWith recorder Info $ LogFailedToResolveComponent err + throwE $ PluginInternalError $ T.pack err + pure $ + AddConfig + { cnfOrigContents = cnfOrigContents + , cnfFields = fields + , cnfComponent = compName + , cnfTargetField = if targetFieldStr == "exposed-modules" then ExposedModules else OtherModules + , cnfAdditions = singleton $ B.pack modulePath + } + +-------------------------------------------- +-- Add build dependency to cabal file +-------------------------------------------- + +addDependencyCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState CabalAddDependencyCommandParams +addDependencyCommand recorder state _ params@(CabalAddDependencyCommandParams{..}) = do + logWith recorder Debug $ LogCalledCabalAddDependencyCommand params + let specifiedDep = case depVersion of + Nothing -> depDependency + Just ver -> depDependency <> " ^>=" <> ver + caps <- lift pluginGetClientCapabilities + let env = (state, caps, depVerTxtDocId) + edit <- getDependencyEdit recorder env depCabalPath depBuildTarget (T.unpack specifiedDep) + void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) + logWith recorder Debug LogExecutedCommand + pure $ InR Null + +{- | Constructs prerequisites for the @executeConfig@ + and runs it, given path to the cabal file and a dependency message. + Given the new contents of the cabal file constructs and returns the @edit@. + Inspired by @main@ in cabal-add, + Distribution.Client.Main +-} +getDependencyEdit :: + forall m. + (MonadIO m) => + Recorder (WithPriority Log) -> + (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> + FilePath -> + Maybe String -> + String -> + ExceptT PluginError m WorkspaceEdit +getDependencyEdit recorder env cabalFilePath buildTarget dependency = + mkCabalAddConfig recorder env cabalFilePath mkConfig + where + mkConfig :: (ByteString -> [Field Position] -> GenericPackageDescription -> ExceptT PluginError m AddConfig) + mkConfig cnfOrigContents fields packDescr = do + let specVer = specVersion $ packageDescription packDescr + (deps, compName) <- + modifyError (\t -> PluginInternalError $ T.pack t) $ do + deps <- validateDependency specVer dependency + compName <- resolveComponent cabalFilePath (fields, packDescr) buildTarget + pure (deps, compName) + pure $ + AddConfig + { cnfOrigContents = cnfOrigContents + , cnfFields = fields + , cnfComponent = compName + , cnfTargetField = BuildDepends + , cnfAdditions = singleton deps + } + +-------------------------------------------- +-- Shared Functions +-------------------------------------------- + +mkCabalAddConfig :: + (MonadIO m) => + Recorder (WithPriority Log) -> + (IdeState, ClientCapabilities, VersionedTextDocumentIdentifier) -> + -- | The cabal file to edit + FilePath -> + -- | Callback to allow configuration of 'AddConfig' to be used by `cabal-add` + ( ByteString -> + [Field Position] -> + GenericPackageDescription -> + ExceptT PluginError m AddConfig + ) -> + ExceptT PluginError m WorkspaceEdit +mkCabalAddConfig recorder env cabalFilePath mkConfig = do + let (state, caps, verTxtDocId) = env + (mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do + contents <- getFileContents $ toNormalizedFilePath cabalFilePath + inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath + inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath + let mbCnfOrigContents = case contents of + (Just txt) -> Just $ encodeUtf8 $ Rope.toText txt + _ -> Nothing + let mbFields = fst <$> inFields + let mbPackDescr = fst <$> inPackDescr + pure (mbCnfOrigContents, mbFields, mbPackDescr) + + -- Check if required info was received, + -- otherwise fall back on other options. + (cnfOrigContents, fields, packDescr) <- do + cnfOrigContents <- case mbCnfOrigContents of + (Just cnfOrigContents) -> pure cnfOrigContents + Nothing -> readCabalFile cabalFilePath + (fields, packDescr) <- case (mbFields, mbPackDescr) of + (Just fields, Just packDescr) -> pure (fields, packDescr) + (_, _) -> case parseCabalFile cabalFilePath cnfOrigContents of + Left err -> throwE $ PluginInternalError $ T.pack err + Right (f, gpd) -> pure (f, gpd) + pure (cnfOrigContents, fields, packDescr) + + cabalAddConfig <- mkConfig cnfOrigContents fields packDescr + + case executeAddConfig (validateChanges packDescr) cabalAddConfig of + Nothing -> + throwE $ + PluginInternalError $ + T.pack $ + "Cannot extend " + ++ show (cnfTargetField cabalAddConfig) + ++ " of " + ++ case (cnfComponent cabalAddConfig) of + Right compName -> showComponentName compName + Left commonStanza -> show commonStanza + ++ " in " + ++ cabalFilePath + Just newContents -> do + let edit = diffText caps (verTxtDocId, T.decodeUtf8 cnfOrigContents) (T.decodeUtf8 newContents) SkipDeletions + logWith recorder Debug $ LogCreatedEdit edit + pure edit diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Types.hs new file mode 100644 index 0000000000..62d6b7a7d3 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/Types.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} + +module Ide.Plugin.Cabal.CabalAdd.Types where + +import Data.Aeson.Types (FromJSON, ToJSON) +import Data.String (IsString) +import qualified Data.Text as T +import Distribution.Compat.Prelude (Generic) +import Distribution.PackageDescription +import Ide.Logger +import Ide.Plugin.Cabal.Orphans () +import Language.LSP.Protocol.Types + +data Log + = LogFoundResponsibleCabalFile FilePath + | LogCalledCabalAddDependencyCommand CabalAddDependencyCommandParams + | LogCalledCabalAddModuleCommand ModuleInsertionConfig + | LogCreatedEdit WorkspaceEdit + | LogExecutedCommand + | LogFailedToResolveComponent String + deriving (Show) + +instance Pretty Log where + pretty = \case + LogFoundResponsibleCabalFile fp -> "Located the responsible cabal file at " <+> pretty fp + LogCalledCabalAddDependencyCommand params -> "Called CabalAddDependency command with:\n" <+> pretty params + LogCalledCabalAddModuleCommand params -> "Called CabalAddModule command with:\n" <+> pretty params + LogCreatedEdit edit -> "Created inplace edit:\n" <+> pretty edit + LogExecutedCommand -> "Executed CabalAdd command" + LogFailedToResolveComponent cS -> "Failed to resolve component in CabalAdd with error:" <+> viaShow cS + +cabalAddDependencyCommandId :: (IsString p) => p +cabalAddDependencyCommandId = "cabalAddDependency" + +cabalAddModuleCommandId :: (IsString p) => p +cabalAddModuleCommandId = "cabalAddModule" + +-- | Relevant data needed to add a module to a cabal file. +-- +-- This will be sent as json to the client with a code action we offer to add this dependency to a cabal file. +-- If the user decides to execute the corresponding code action, the client sends us this data again, and we then +-- use it to execute the `CabalAddDependencyCommand`. +data ModuleInsertionConfig = ModuleInsertionConfig + { targetFile :: FilePath + -- ^ The file we want to insert information about the new module into. + , moduleToInsert :: T.Text + -- ^ The module name of the module to be inserted into the targetFile at the insertionPosition. + , modVerTxtDocId :: VersionedTextDocumentIdentifier + , insertionStanza :: ComponentName + -- ^ Which stanza the module will be inserted into. + , insertionLabel :: T.Text + -- ^ A label which describes which field the module will be inserted into. + } + deriving (Show, Eq, Ord, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty ModuleInsertionConfig where + pretty ModuleInsertionConfig{..} = + "CabalAddModule parameters:" + <+> vcat + [ "cabal path:" <+> pretty targetFile + , "target:" <+> pretty moduleToInsert + , "stanza:" <+> viaShow insertionStanza + , "label:" <+> pretty insertionLabel + ] + +-- | Contains all source directories of a stanza with the name of the first parameter. +data StanzaItem = StanzaItem + { siComponent :: ComponentName + , siHsSourceDirs :: [FilePath] + } + deriving (Show) + +-- | Relevant data needed to add a dependency to a cabal file. +-- +-- This will be sent as json to the client with a code action we offer to add this dependency to a cabal file. +-- If the user decides to execute the corresponding code action, the client sends us this data again, and we then +-- use it to execute the `CabalAddDependencyCommand`. +data CabalAddDependencyCommandParams = CabalAddDependencyCommandParams + { depCabalPath :: FilePath + , depVerTxtDocId :: VersionedTextDocumentIdentifier + , depBuildTarget :: Maybe String + , depDependency :: T.Text + , depVersion :: Maybe T.Text + } + deriving (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty CabalAddDependencyCommandParams where + pretty CabalAddDependencyCommandParams{..} = + "CabalAddDependency parameters:" + <+> vcat + [ "cabal path:" <+> pretty depCabalPath + , "target:" <+> pretty depBuildTarget + , "dependendency:" <+> pretty depDependency + , "version:" <+> pretty depVersion + ] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Files.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Files.hs new file mode 100644 index 0000000000..28cf1e39a8 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Files.hs @@ -0,0 +1,56 @@ +module Ide.Plugin.Cabal.Files where + +import Control.Monad (filterM) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Except +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.Text as T +import Distribution.PackageDescription.Quirks (patchQuirks) +import Distribution.Simple.Utils (safeHead) +import Ide.Plugin.Cabal.Orphans () +import Ide.Plugin.Error +import System.Directory (doesFileExist, + listDirectory) +import System.FilePath + +{- | Given a path to a haskell file, returns the closest cabal file. + If a package.yaml is present in same directory as the .cabal file, returns nothing, + because adding a dependency to a generated cabal file will break propagation of changes + from package.yaml to cabal files in stack projects. + If cabal file wasn't found, returns Nothing. +-} +findResponsibleCabalFile :: FilePath -> IO (Maybe FilePath) +findResponsibleCabalFile haskellFilePath = do + let dirPath = dropFileName haskellFilePath + allDirPaths = reverse $ scanl1 () (splitPath dirPath) -- sorted from most to least specific + go allDirPaths + where + go [] = pure Nothing + go (path : ps) = do + objects <- listDirectory path + let objectsWithPaths = map (\obj -> path <> obj) objects + objectsCabalExtension = filter (\c -> takeExtension c == ".cabal") objectsWithPaths + cabalFiles <- filterM (\c -> doesFileExist c) objectsCabalExtension + case safeHead cabalFiles of + Nothing -> go ps + Just cabalFile -> guardAgainstHpack path cabalFile + where + guardAgainstHpack :: FilePath -> FilePath -> IO (Maybe FilePath) + guardAgainstHpack path cabalFile = do + exists <- doesFileExist $ path "package.yaml" + if exists then pure Nothing else pure $ Just cabalFile + +{- | Gives a cabal file's contents or throws error. + + Inspired by @readCabalFile@ in cabal-add, Distribution.Client.Main + + This is a fallback option! + Use only if the `GetFileContents` fails. +-} +readCabalFile :: (MonadIO m) => FilePath -> ExceptT PluginError m ByteString +readCabalFile fileName = do + cabalFileExists <- liftIO $ doesFileExist fileName + if cabalFileExists + then snd . patchQuirks <$> liftIO (B.readFile fileName) + else throwE $ PluginInternalError $ T.pack ("Failed to read cabal file at " <> fileName) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs new file mode 100644 index 0000000000..67cf97ccee --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.Cabal.OfInterest (ofInterestRules, getCabalFilesOfInterestUntracked, addFileOfInterest, deleteFileOfInterest, kick, Log) where + +import Control.Concurrent.Strict +import Control.DeepSeq +import Control.Monad.IO.Class +import qualified Data.ByteString as BS +import Data.Hashable +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Proxy +import qualified Data.Text () +import Development.IDE as D +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key, alwaysRerun) +import Development.IDE.Types.Shake (toKey) +import GHC.Generics +import qualified Ide.Plugin.Cabal.Completion.Types as Types +import Ide.Plugin.Cabal.Orphans () + +data Log + = LogShake Shake.Log + | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus) + deriving (Show) + +instance Pretty Log where + pretty = \case + LogShake log' -> pretty log' + LogFOI files -> + "Set files of interest to:" <+> viaShow files + +-- ---------------------------------------------------------------- +-- Cabal file of interest rules and global variable +-- ---------------------------------------------------------------- + +{- | Cabal files that are currently open in the lsp-client. +Specific actions happen when these files are saved, closed or modified, +such as generating diagnostics, re-parsing, etc... + +We need to store the open files to parse them again if we restart the shake session. +Restarting of the shake session happens whenever these files are modified. +-} +newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) + +instance Shake.IsIdeGlobal OfInterestCabalVar + +data IsCabalFileOfInterest = IsCabalFileOfInterest + deriving (Eq, Show, Generic) +instance Hashable IsCabalFileOfInterest +instance NFData IsCabalFileOfInterest + +type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult + +data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus + deriving (Eq, Show, Generic) +instance Hashable CabalFileOfInterestResult +instance NFData CabalFileOfInterestResult + +{- | The rule that initialises the files of interest state. + +Needs to be run on start-up. +-} +ofInterestRules :: Recorder (WithPriority Log) -> Rules () +ofInterestRules recorder = do + Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty) + Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do + alwaysRerun + filesOfInterest <- getCabalFilesOfInterestUntracked + let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest + fp = summarize foi + res = (Just fp, Just foi) + return res + where + summarize NotCabalFOI = BS.singleton 0 + summarize (IsCabalFOI OnDisk) = BS.singleton 1 + summarize (IsCabalFOI (Modified False)) = BS.singleton 2 + summarize (IsCabalFOI (Modified True)) = BS.singleton 3 + +getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus) +getCabalFilesOfInterestUntracked = do + OfInterestCabalVar var <- Shake.getIdeGlobalAction + liftIO $ readVar var + +addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key] +addFileOfInterest recorder state f v = do + OfInterestCabalVar var <- Shake.getIdeGlobalState state + (prev, files) <- modifyVar var $ \dict -> do + let (prev, new) = HashMap.alterF (,Just v) f dict + pure (new, (prev, new)) + if prev /= Just v + then do + log' Debug $ LogFOI files + return [toKey IsCabalFileOfInterest f] + else return [] + where + log' = logWith recorder + +deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key] +deleteFileOfInterest recorder state f = do + OfInterestCabalVar var <- Shake.getIdeGlobalState state + files <- modifyVar' var $ HashMap.delete f + log' Debug $ LogFOI files + return [toKey IsFileOfInterest f] + where + log' = logWith recorder + +{- | This is the kick function for the cabal plugin. +We run this action, whenever we shake session us run/restarted, which triggers +actions to produce diagnostics for cabal files. + +It is paramount that this kick-function can be run quickly, since it is a blocking +function invocation. +-} +kick :: Action () +kick = do + files <- HashMap.keys <$> getCabalFilesOfInterestUntracked + Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Orphans.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Orphans.hs index 2264d5390f..8ecb361025 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Orphans.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Orphans.hs @@ -1,8 +1,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Ide.Plugin.Cabal.Orphans where import Control.DeepSeq +import Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import qualified Data.Text as T import Distribution.Fields.Field -import Distribution.Parsec.Position +import Distribution.PackageDescription (ComponentName) +import Distribution.Parsec +import Distribution.Pretty (prettyShow) -- ---------------------------------------------------------------- -- Cabal-syntax orphan instances we need sometimes @@ -22,3 +28,12 @@ instance NFData (SectionArg Position) where rnf (SecArgName ann bs) = rnf ann `seq` rnf bs rnf (SecArgStr ann bs) = rnf ann `seq` rnf bs rnf (SecArgOther ann bs) = rnf ann `seq` rnf bs + +instance ToJSON ComponentName where + toJSON = Aeson.String . T.pack . prettyShow + +instance FromJSON ComponentName where + parseJSON = Aeson.withText "ComponentName" $ \t -> + case eitherParsec (T.unpack t) of + Left err -> Aeson.parseFail err + Right r -> pure r diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs index e949af1b1d..f2b3d74639 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Parse.hs @@ -22,9 +22,9 @@ import qualified Distribution.Parsec.Position as Syntax parseCabalFileContents :: BS.ByteString -- ^ UTF-8 encoded bytestring - -> IO ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) + -> ([PWarning], Either (Maybe Version, NonEmpty PError) GenericPackageDescription) parseCabalFileContents bs = - pure $ runParseResult (parseGenericPackageDescription bs) + runParseResult (parseGenericPackageDescription bs) readCabalFields :: NormalizedFilePath -> diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs new file mode 100644 index 0000000000..de7bb9a5fd --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.Cabal.Rules (cabalRules, Log) where + +import Control.Monad.IO.Class +import qualified Data.ByteString as BS +import qualified Data.List as List +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as Maybe +import qualified Data.Text () +import qualified Data.Text as T +import qualified Data.Text.Encoding as Encoding +import Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE as D +import qualified Development.IDE.Core.Shake as Shake +import qualified Distribution.CabalSpecVersion as Cabal +import qualified Distribution.Fields as Syntax +import Distribution.Parsec.Error +import qualified Ide.Plugin.Cabal.Completion.Data as Data +import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections), + ParseCabalFields (..), + ParseCabalFile (..)) +import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics +import qualified Ide.Plugin.Cabal.OfInterest as OfInterest +import Ide.Plugin.Cabal.Orphans () +import qualified Ide.Plugin.Cabal.Parse as Parse +import Ide.Types +import Text.Regex.TDFA + +data Log + = LogModificationTime NormalizedFilePath FileVersion + | LogShake Shake.Log + | LogOfInterest OfInterest.Log + | LogDocSaved Uri + deriving (Show) + +instance Pretty Log where + pretty = \case + LogShake log' -> pretty log' + LogOfInterest log' -> pretty log' + LogModificationTime nfp modTime -> + "Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime) + LogDocSaved uri -> + "Saved text document:" <+> pretty (getUri uri) + +cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules () +cabalRules recorder plId = do + -- Make sure we initialise the cabal files-of-interest. + OfInterest.ofInterestRules (cmapWithPrio LogOfInterest recorder) + -- Rule to produce diagnostics for cabal files. + define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do + config <- getPluginConfigAction plId + if not (plcGlobalOn config && plcDiagnosticsOn config) + then pure ([], Nothing) + else do + -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), + -- we rerun this rule because this rule *depends* on GetModificationTime. + (t, mCabalSource) <- use_ GetFileContents file + log' Debug $ LogModificationTime file t + contents <- case mCabalSource of + Just sources -> + pure $ Encoding.encodeUtf8 $ Rope.toText sources + Nothing -> do + liftIO $ BS.readFile $ fromNormalizedFilePath file + + case Parse.readCabalFields file contents of + Left _ -> + pure ([], Nothing) + Right fields -> + pure ([], Just fields) + + define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections file -> do + fields <- use_ ParseCabalFields file + let commonSections = + Maybe.mapMaybe + ( \case + commonSection@(Syntax.Section (Syntax.Name _ "common") _ _) -> Just commonSection + _ -> Nothing + ) + fields + pure ([], Just commonSections) + + define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do + config <- getPluginConfigAction plId + if not (plcGlobalOn config && plcDiagnosticsOn config) + then pure ([], Nothing) + else do + -- whenever this key is marked as dirty (e.g., when a user writes stuff to it), + -- we rerun this rule because this rule *depends* on GetModificationTime. + (t, mCabalSource) <- use_ GetFileContents file + log' Debug $ LogModificationTime file t + contents <- case mCabalSource of + Just sources -> + pure $ Encoding.encodeUtf8 $ Rope.toText sources + Nothing -> do + liftIO $ BS.readFile $ fromNormalizedFilePath file + + -- Instead of fully reparsing the sources to get a 'GenericPackageDescription', + -- we would much rather re-use the already parsed results of 'ParseCabalFields'. + -- Unfortunately, Cabal-syntax doesn't expose the function 'parseGenericPackageDescription'' + -- which allows us to resume the parsing pipeline with '[Field Position]'. + let (pWarnings, pm) = Parse.parseCabalFileContents contents + let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings + case pm of + Left (_cabalVersion, pErrorNE) -> do + let regexUnknownCabalBefore310 :: T.Text + -- We don't support the cabal version, this should not be an error, as the + -- user did not do anything wrong. Instead we cast it to a warning + regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*" + regexUnknownCabalVersion :: T.Text + regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+" + unsupportedCabalHelpText = + unlines + [ "The used `cabal-version` is not fully supported by this `HLS` binary." + , "Either the `cabal-version` is unknown, or too new for this executable." + , "This means that some functionality might not work as expected." + , "If you face any issues, try downgrading to a supported `cabal-version` or upgrading `HLS` if possible." + , "" + , "Supported versions are: " + <> List.intercalate + ", " + (fmap Cabal.showCabalSpecVersion Data.supportedCabalVersions) + ] + errorDiags = + NE.toList $ + NE.map + ( \pe@(PError pos text) -> + if any + (text =~) + [ regexUnknownCabalBefore310 + , regexUnknownCabalVersion + ] + then + Diagnostics.warningDiagnostic + file + ( Syntax.PWarning Syntax.PWTOther pos $ + unlines + [ text + , unsupportedCabalHelpText + ] + ) + else Diagnostics.errorDiagnostic file pe + ) + pErrorNE + allDiags = errorDiags <> warningDiags + pure (allDiags, Nothing) + Right gpd -> do + pure (warningDiags, Just gpd) + + action $ do + -- Run the cabal kick. This code always runs when 'shakeRestart' is run. + -- Must be careful to not impede the performance too much. Crucial to + -- a snappy IDE experience. + OfInterest.kick + where + log' = logWith recorder diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index 6517c811fe..8cbac90e43 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -1,56 +1,112 @@ -{-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} module CabalAdd ( - cabalAddTests, + cabalAddDependencyTests, + cabalAddModuleTests, ) where -import Control.Lens ((^.)) -import Control.Lens.Fold ((^?)) -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Text.Internal.Search as T -import Distribution.Utils.Generic (safeHead) -import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion) -import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Types (Diagnostic (..), mkRange) +import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Internal.Search as T +import Distribution.ModuleName (fromString) +import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import qualified Distribution.Pretty as Pretty +import Distribution.Types.Component +import Distribution.Utils.Generic (safeHead) +import Ide.Plugin.Cabal.CabalAdd.CodeAction (hiddenPackageSuggestion) +import Ide.Plugin.Cabal.Parse (parseCabalFileContents) +import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Types as J import System.FilePath -import Test.Hls (Session, TestTree, _R, anyMessage, - assertEqual, documentContents, - executeCodeAction, - getAllCodeActions, - getDocumentEdit, liftIO, openDoc, - skipManyTill, testCase, testGroup, - waitForDiagnosticsFrom, (@?=)) +import Test.Hls import Utils -cabalAddTests :: TestTree -cabalAddTests = +cabalAddModuleTests :: TestTree +cabalAddModuleTests = + testGroup + "Add Module" + [ runHaskellTestCaseSession "Add to benchmark" ("cabal-add-module" "library") $ do + let compName = CBenchName "test1" + pd <- generateAddDependencyTestSession "test.cabal" "Main.hs" compName + checkModuleAddedTo pd "Main" compName + , runHaskellTestCaseSession "Add to executable" ("cabal-add-module" "library") $ do + let compName = CExeName "test" + pd <- generateAddDependencyTestSession "test.cabal" "Main.hs" compName + checkModuleAddedTo pd "Main" compName + , runHaskellTestCaseSession "Add to test-suite" ("cabal-add-module" "library") $ do + let compName = CTestName "test2" + pd <- generateAddDependencyTestSession "test.cabal" "Main.hs" compName + checkModuleAddedTo pd "Main" compName + , runHaskellTestCaseSession "Add to library" ("cabal-add-module" "library") $ do + let compName = CLibName $ LSubLibName "test3" + pd <- generateAddDependencyTestSession "test.cabal" "Main.hs" compName + checkModuleAddedTo pd "Main" compName + , runHaskellTestCaseSession "Add to main library" ("cabal-add-module" "library") $ do + let compName = CLibName LMainLibName + pd <- generateAddDependencyTestSession "test.cabal" "Main.hs" compName + checkModuleAddedTo pd "Main" compName + ] + where + generateAddDependencyTestSession :: FilePath -> FilePath -> ComponentName -> Session PackageDescription + generateAddDependencyTestSession cabalFile haskellFile compName = do + haskellDoc <- openDoc haskellFile "haskell" + cabalDoc <- openDoc cabalFile "cabal" + _ <- waitForDiagnosticsFrom haskellDoc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions haskellDoc + let selectedCas = filter (\ca -> (T.pack $ "Add to " <> Pretty.prettyShow compName <> " ") `T.isPrefixOf` (ca ^. L.title)) cas + mapM_ executeCodeAction $ selectedCas + _ <- skipManyTill anyMessage $ getDocumentEdit cabalDoc -- Wait for the changes in cabal file + contents <- documentContents cabalDoc + case parseCabalFileContents $ T.encodeUtf8 contents of + (_, Right gpd) -> pure $ flattenPackageDescription gpd + _ -> liftIO $ assertFailure "could not parse cabal file to gpd" + + -- | Verify that the given module was added to the desired component. + -- Note that we do not care whether it was added to exposed-modules or other-modules of that component. + checkModuleAddedTo :: PackageDescription -> String -> ComponentName -> Session () + checkModuleAddedTo pd modName compName = do + let comp = getComponent pd compName + compModules = case comp of + CLib lib -> explicitLibModules lib + CFLib fLib -> foreignLibModules fLib + CExe exe -> exeModules exe + CTest test -> testModules test + CBench bench -> benchmarkModules bench + testDescription = modName <> " was added to " <> showComponentName compName + liftIO $ assertBool testDescription $ fromString modName `elem` compModules + +cabalAddDependencyTests :: TestTree +cabalAddDependencyTests = testGroup - "CabalAdd Tests" - [ runHaskellTestCaseSession "Code Actions - Can add hidden package to an executable" ("cabal-add-testdata" "cabal-add-exe") + "Add dependency" + [ runHaskellTestCaseSession "Add to executable" ("cabal-add-testdata" "cabal-add-exe") (generateAddDependencyTestSession "cabal-add-exe.cabal" ("src" "Main.hs") "split" [253]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" "cabal-add-lib") + , runHaskellTestCaseSession "Add to library" ("cabal-add-testdata" "cabal-add-lib") (generateAddDependencyTestSession "cabal-add-lib.cabal" ("src" "MyLib.hs") "split" [348]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" "cabal-add-tests") + , runHaskellTestCaseSession "Add to testsuite" ("cabal-add-testdata" "cabal-add-tests") (generateAddDependencyTestSession "cabal-add-tests.cabal" ("test" "Main.hs") "split" [478]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test with PackageImports" ("cabal-add-testdata" "cabal-add-tests") + , runHaskellTestCaseSession "Add to testsuite with PackageImports" ("cabal-add-testdata" "cabal-add-tests") (generateAddDependencyTestSession "cabal-add-tests.cabal" ("test" "MainPackageImports.hs") "split" [731]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" "cabal-add-bench") + , runHaskellTestCaseSession "Add to benchmark" ("cabal-add-testdata" "cabal-add-bench") (generateAddDependencyTestSession "cabal-add-bench.cabal" ("bench" "Main.hs") "split" [403]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to an executable, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") + , runHaskellTestCaseSession "Add to executable, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") (generateAddDependencyTestSession "cabal-add-multitarget.cabal" ("src" "Main.hs") "split" [269]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a library, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") + , runHaskellTestCaseSession "Add to library, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") (generateAddDependencyTestSession "cabal-add-multitarget.cabal" ("lib" "MyLib.hs") "split" [413]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to an internal library, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") + , runHaskellTestCaseSession "Add to internal library, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") (generateAddDependencyTestSession "cabal-add-multitarget.cabal" ("lib" "InternalLib.hs") "split" [413]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a test, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") + , runHaskellTestCaseSession "Add to testsuite, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") (generateAddDependencyTestSession "cabal-add-multitarget.cabal" ("test" "Main.hs") "split" [655]) - , runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") + , runHaskellTestCaseSession "Add to benchmark, multiple targets" ("cabal-add-testdata" "cabal-add-multitarget") (generateAddDependencyTestSession "cabal-add-multitarget.cabal" ("bench" "Main.hs") "split" [776]) - , runHaskellTestCaseSession "Code Actions - Guard against HPack" ("cabal-add-testdata" "cabal-add-packageYaml") + , runHaskellTestCaseSession "Guard against HPack" ("cabal-add-testdata" "cabal-add-packageYaml") (generatePackageYAMLTestSession ("src" "Main.hs")) , testHiddenPackageSuggestions "Check CabalAdd's parser, no version" @@ -156,7 +212,7 @@ cabalAddTests = liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (T.indices dependency contents) testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree testHiddenPackageSuggestions testTitle messages suggestions = - let diags = map (\msg -> messageToDiagnostic msg ) messages + let diags = map (\msg -> messageToDiagnostic msg) messages suggestions' = map (safeHead . hiddenPackageSuggestion) diags assertions = zipWith (@?=) suggestions' (map Just suggestions) testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions @@ -164,20 +220,19 @@ cabalAddTests = in test messageToDiagnostic :: T.Text -> Diagnostic messageToDiagnostic msg = Diagnostic { - _range = mkRange 0 0 0 0 - , _severity = Nothing - , _code = Nothing - , _source = Nothing - , _message = msg - , _relatedInformation = Nothing - , _tags = Nothing - , _codeDescription = Nothing - , _data_ = Nothing + J._range = mkRange 0 0 0 0 + , J._severity = Nothing + , J._code = Nothing + , J._source = Nothing + , J._message = msg + , J._relatedInformation = Nothing + , J._tags = Nothing + , J._codeDescription = Nothing + , J._data_ = Nothing } - generatePackageYAMLTestSession :: FilePath -> Session () - generatePackageYAMLTestSession haskellFile = do + generatePackageYAMLTestSession haskellFile = do hsdoc <- openDoc haskellFile "haskell" _ <- waitForDiagnosticsFrom hsdoc cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index fcb85a081e..43794e753d 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,12 +1,15 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Main ( main, ) where -import CabalAdd (cabalAddTests) +import CabalAdd (cabalAddDependencyTests, + cabalAddModuleTests) import Completer (completerTests) import Context (contextTests) import Control.Lens ((^.)) @@ -16,14 +19,19 @@ import qualified Data.ByteString as BS import Data.Either (isRight) import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe +import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as Text import Definition (gotoDefinitionTests) +import Development.IDE.Test import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Message as L import Outline (outlineTests) import System.FilePath import Test.Hls +import Test.Hls.FileSystem import Utils main :: IO () @@ -39,6 +47,7 @@ main = do , codeActionTests , gotoDefinitionTests , hoverTests + , reloadOnCabalChangeTests ] -- ------------------------------------------------------------------------ @@ -58,7 +67,8 @@ cabalParserUnitTests = testGroup "Parsing Cabal" [ testCase "Simple Parsing works" $ do - (warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir "simple.cabal") + fileContents <- BS.readFile (testDataDir "simple.cabal") + let (warnings, pm) = Lib.parseCabalFileContents fileContents liftIO $ do null warnings @? "Found unexpected warnings" isRight pm @? "Failed to parse GenericPackageDescription" @@ -89,7 +99,7 @@ codeActionUnitTests = maxCompletions = 100 --- ------------------------ ------------------------------------------------ +-- ------------------------------------------------------------------------ -- Integration Tests -- ------------------------------------------------------------------------ @@ -126,11 +136,6 @@ pluginTests = _ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n" newDiags <- cabalCaptureKick liftIO $ newDiags @?= [] - , runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do - hsDoc <- openDoc "A.hs" "haskell" - expectNoMoreDiagnostics 1 hsDoc "typechecking" - cabalDoc <- openDoc "simple-cabal.cabal" "cabal" - expectNoMoreDiagnostics 1 cabalDoc "parsing" ] ] -- ---------------------------------------------------------------------------- @@ -208,7 +213,8 @@ codeActionTests = testGroup "Code Actions" ]) cas mapM_ executeCodeAction selectedCas pure () - , cabalAddTests + , cabalAddDependencyTests + , cabalAddModuleTests ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] @@ -259,3 +265,63 @@ hoverOnDependencyTests = testGroup "Hover Dependency" h <- getHover doc pos liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h closeDoc doc + +-- ---------------------------------------------------------------------------- +-- Reloading of Haskell files on .cabal changes +-- ---------------------------------------------------------------------------- + +simpleCabalVft :: [FileTree] +simpleCabalVft = + [ copy "hie.yaml" + , copy "simple-reload.cabal" + , copy "Main.hs" + ] + +simpleCabalFs :: VirtualFileTree +simpleCabalFs = mkVirtualFileTree + (testDataDir "simple-reload") + simpleCabalVft + +-- Slow tests +reloadOnCabalChangeTests :: TestTree +reloadOnCabalChangeTests = testGroup "Reload on .cabal changes" + [ runCabalTestCaseSessionVft "Change warnings when .cabal file changes" simpleCabalFs $ do + _ <- openDoc "Main.hs" "haskell" + expectDiagnostics [("Main.hs", [(DiagnosticSeverity_Warning, (8, 0), "Top-level binding with no type signature", Just "GHC-38417")])] + waitForAllProgressDone + cabalDoc <- openDoc "simple-reload.cabal" "cabal" + skipManyTill anyMessage cabalKickDone + saveDoc cabalDoc + [trimming| + cabal-version: 3.4 + name: simple-reload + version: 0.1.0.0 + -- copyright: + build-type: Simple + + common warnings + ghc-options: -Wall -Wno-missing-signatures + + executable simple-reload + import: warnings + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + |] + + expectDiagnostics [("Main.hs", [(DiagnosticSeverity_Warning, (2, 0), "The import of \8216Data.List\8217 is redundant", Nothing)])] + ] + +-- | Persists the given contents to the 'TextDocumentIdentifier' on disk +-- and sends the @textDocument/didSave@ notification. +saveDoc :: TextDocumentIdentifier -> Text -> Session () +saveDoc docId t = do + -- I couldn't figure out how to get the virtual file contents, so we write it + -- to disk and send the 'SMethod_TextDocumentDidSave' notification + case uriToFilePath (docId ^. L.uri) of + Nothing -> pure () + Just fp -> do + liftIO $ Text.writeFile fp t + + let params = DidSaveTextDocumentParams docId Nothing + sendNotification L.SMethod_TextDocumentDidSave params diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index 2733f94fd0..0264fec2c6 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -14,6 +14,7 @@ import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types import System.FilePath import Test.Hls +import Test.Hls.FileSystem (VirtualFileTree) cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log @@ -57,6 +58,13 @@ runCabalSession :: FilePath -> Session a -> IO a runCabalSession subdir = failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir subdir) +runCabalTestCaseSessionVft :: TestName -> VirtualFileTree -> Session () -> TestTree +runCabalTestCaseSessionVft title vft = testCase title . runCabalSessionVft vft + +runCabalSessionVft :: VirtualFileTree -> Session a -> IO a +runCabalSessionVft vft = + failIfSessionTimeout . runSessionWithServerInTmpDir def cabalPlugin vft + runHaskellAndCabalSession :: FilePath -> Session a -> IO a runHaskellAndCabalSession subdir = failIfSessionTimeout . runSessionWithServer def (cabalPlugin <> cabalHaskellPlugin) (testDataDir subdir) @@ -82,3 +90,4 @@ cabalCaptureKick = captureKickDiagnostics cabalKickStart cabalKickDone -- | list comparison where the order in the list is irrelevant (@?==) :: (HasCallStack, Ord a, Show a) => [a] -> [a] -> Assertion (@?==) l1 l2 = sort l1 @?= sort l2 + diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/Main.hs b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/Main.hs new file mode 100644 index 0000000000..c2e4af9606 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = undefined diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/cabal.project b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/cabal.project new file mode 100644 index 0000000000..e6fdbadb43 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/hie.yaml new file mode 100644 index 0000000000..04cd24395e --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/test.cabal b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/test.cabal new file mode 100644 index 0000000000..bb6dc95f2f --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/cabal-add-module/library/test.cabal @@ -0,0 +1,26 @@ +cabal-version: 3.0 +name: test +version: 0.1.0.0 +build-type: Simple + +library + hs-source-dirs: . + exposed-modules: + build-depends: base + default-language: Haskell2010 + +executable test + main-is: bla + build-depends: base + +benchmark test1 + type: exitcode-stdio-1.0 + main-is: bla + build-depends: base + +test-suite test2 + type: exitcode-stdio-1.0 + main-is: bla + build-depends: base + +library test3 diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-reload/Main.hs b/plugins/hls-cabal-plugin/test/testdata/simple-reload/Main.hs new file mode 100644 index 0000000000..5f0cdfad80 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-reload/Main.hs @@ -0,0 +1,9 @@ +module Main where + +import Data.List -- Intentionally unused import, used in the testcase + +main :: IO () +main = foo + +-- Missing signature +foo = putStrLn "Hello, World" diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-reload/cabal.project b/plugins/hls-cabal-plugin/test/testdata/simple-reload/cabal.project new file mode 100644 index 0000000000..e6fdbadb43 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-reload/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-reload/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/simple-reload/hie.yaml new file mode 100644 index 0000000000..04cd24395e --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-reload/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/plugins/hls-cabal-plugin/test/testdata/simple-reload/simple-reload.cabal b/plugins/hls-cabal-plugin/test/testdata/simple-reload/simple-reload.cabal new file mode 100644 index 0000000000..359940aebc --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/simple-reload/simple-reload.cabal @@ -0,0 +1,14 @@ +cabal-version: 3.4 +name: simple-reload +version: 0.1.0.0 +-- copyright: +build-type: Simple + +common warnings + ghc-options: -Wall -Wno-unused-imports + +executable simple-reload + import: warnings + main-is: Main.hs + build-depends: base + default-language: Haskell2010 diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index 06e9d99679..b897fa5abb 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -24,6 +24,12 @@ import Development.IDE import Development.IDE.Core.Shake import Development.IDE.GHC.Compat as Compat import Development.IDE.Spans.AtPoint +import GHC.Iface.Ext.Types (ContextInfo (..), + DeclType (..), HieAST (..), + HieASTs (..), Identifier, + IdentifierDetails (..), + RecFieldContext (..), Span) +import GHC.Iface.Ext.Utils (getNameBinding) import HieDb (Symbol (Symbol)) import qualified Ide.Plugin.CallHierarchy.Query as Q import Ide.Plugin.CallHierarchy.Types diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index df776e6d15..8b8b7e7d3a 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -1,47 +1,93 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} -- | An HLS plugin to provide code actions to change type signatures module Ide.Plugin.ChangeTypeSignature (descriptor -- * For Unit Tests + , Log(..) , errorMessageRegexes ) where -import Control.Monad (guard) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Except (ExceptT) -import Data.Foldable (asum) -import qualified Data.Map as Map -import Data.Maybe (mapMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Development.IDE (realSrcSpanToRange) +import Control.Lens +import Control.Monad (guard) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..)) +import Control.Monad.Trans.Maybe (MaybeT (..), hoistMaybe) +import Data.Foldable (asum) +import qualified Data.Map as Map +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE (FileDiagnostic, + IdeState (..), Pretty (..), + Priority (..), Recorder, + WithPriority, + fdLspDiagnosticL, + fdStructuredMessageL, + logWith, realSrcSpanToRange) import Development.IDE.Core.PluginUtils -import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule)) -import Development.IDE.Core.Service (IdeState) -import Development.IDE.GHC.Compat -import Development.IDE.GHC.Util (printOutputable) -import Generics.SYB (extQ, something) -import Ide.Plugin.Error (PluginError, - getNormalizedFilePathE) -import Ide.Types (PluginDescriptor (..), - PluginId (PluginId), - PluginMethodHandler, - defaultPluginDescriptor, - mkPluginHandler) +import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule)) +import Development.IDE.GHC.Compat hiding (vcat) +import Development.IDE.GHC.Compat.Error (_MismatchMessage, + _TcRnMessageWithCtx, + _TcRnMessageWithInfo, + _TcRnSolverReport, + _TypeEqMismatchActual, + _TypeEqMismatchExpected, + msgEnvelopeErrorL, + reportContentL) +import Development.IDE.GHC.Util (printOutputable) +import Development.IDE.Types.Diagnostics (_SomeStructuredMessage) +import Generics.SYB (extQ, something) +import GHC.Tc.Errors.Types (ErrInfo (..), + TcRnMessageDetailed (..)) +import qualified Ide.Logger as Logger +import Ide.Plugin.Error (PluginError, + getNormalizedFilePathE) +import Ide.Types (Config, HandlerM, + PluginDescriptor (..), + PluginId (PluginId), + PluginMethodHandler, + defaultPluginDescriptor, + mkPluginHandler) import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Text.Regex.TDFA ((=~)) - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId "Provides a code action to change the type signature of a binding if it is wrong") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeActionHandler plId) } - -codeActionHandler :: PluginId -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction -codeActionHandler plId ideState _ CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext diags _ _} = do - nfp <- getNormalizedFilePathE uri - decls <- getDecls plId ideState nfp - let actions = mapMaybe (generateAction plId uri decls) diags - pure $ InL actions +import Text.Regex.TDFA ((=~)) + +data Log + = LogErrInfoCtxt ErrInfo + | LogFindSigLocFailure DeclName + +instance Pretty Log where + pretty = \case + LogErrInfoCtxt (ErrInfo ctxt suppl) -> + Logger.vcat [fromSDoc ctxt, fromSDoc suppl] + LogFindSigLocFailure name -> + pretty ("Lookup signature location failure: " <> name) + where + fromSDoc = pretty . printOutputable + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = + (defaultPluginDescriptor plId "Provides a code action to change the type signature of a binding if it is wrong") + { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeActionHandler recorder plId) + } + +codeActionHandler + :: Recorder (WithPriority Log) + -> PluginId + -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction +codeActionHandler recorder plId ideState _ CodeActionParams{_textDocument, _range} = do + let TextDocumentIdentifier uri = _textDocument + nfp <- getNormalizedFilePathE uri + decls <- getDecls plId ideState nfp + + activeDiagnosticsInRange (shakeExtras ideState) nfp _range >>= \case + Nothing -> pure (InL []) + Just fileDiags -> do + actions <- lift $ mapM (generateAction recorder plId uri decls) fileDiags + pure (InL (catMaybes actions)) getDecls :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m [LHsDecl GhcPs] getDecls (PluginId changeTypeSignatureId) state = @@ -67,39 +113,74 @@ data ChangeSignature = ChangeSignature { -- | the location of the declaration signature , declSrcSpan :: RealSrcSpan -- | the diagnostic to solve - , diagnostic :: Diagnostic + , diagnostic :: FileDiagnostic } -- | Create a CodeAction from a Diagnostic -generateAction :: PluginId -> Uri -> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction) -generateAction plId uri decls diag = changeSigToCodeAction plId uri <$> diagnosticToChangeSig decls diag +generateAction + :: Recorder (WithPriority Log) + -> PluginId + -> Uri + -> [LHsDecl GhcPs] + -> FileDiagnostic + -> HandlerM Config (Maybe (Command |? CodeAction)) +generateAction recorder plId uri decls fileDiag = do + changeSig <- diagnosticToChangeSig recorder decls fileDiag + pure $ + changeSigToCodeAction plId uri <$> changeSig -- | Convert a diagnostic into a ChangeSignature and add the proper SrcSpan -diagnosticToChangeSig :: [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature -diagnosticToChangeSig decls diagnostic = do - -- regex match on the GHC Error Message - (expectedType, actualType, declName) <- matchingDiagnostic diagnostic - -- Find the definition and it's location - declSrcSpan <- findSigLocOfStringDecl decls expectedType (T.unpack declName) - pure $ ChangeSignature{..} - +diagnosticToChangeSig + :: Recorder (WithPriority Log) + -> [LHsDecl GhcPs] + -> FileDiagnostic + -> HandlerM Config (Maybe ChangeSignature) +diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do + -- Extract expected, actual, and extra error info + (expectedType, actualType, errInfo) <- hoistMaybe $ do + msg <- diagnostic ^. fdStructuredMessageL ^? _SomeStructuredMessage + tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessageWithCtx + (_, TcRnMessageDetailed errInfo tcRnMsg') <- tcRnMsg ^? _TcRnMessageWithInfo + solverReport <- tcRnMsg' ^? _TcRnSolverReport . _1 . reportContentL + mismatch <- solverReport ^? _MismatchMessage + expectedType <- mismatch ^? _TypeEqMismatchExpected + actualType <- mismatch ^? _TypeEqMismatchActual + + pure (showType expectedType, showType actualType, errInfo) + + logWith recorder Debug (LogErrInfoCtxt errInfo) + + -- Extract the declName from the extra error text + declName <- hoistMaybe (matchingDiagnostic errInfo) + + -- Look up location of declName. If it fails, log it + declSrcSpan <- + case findSigLocOfStringDecl decls expectedType (T.unpack declName) of + Just x -> pure x + Nothing -> do + logWith recorder Debug (LogFindSigLocFailure declName) + hoistMaybe Nothing + + pure ChangeSignature{..} + where + showType :: Type -> Text + showType = T.pack . showSDocUnsafe . pprTidiedType -- | If a diagnostic has the proper message create a ChangeSignature from it -matchingDiagnostic :: Diagnostic -> Maybe (ExpectedSig, ActualSig, DeclName) -matchingDiagnostic Diagnostic{_message} = asum $ map (unwrapMatch . (=~) _message) errorMessageRegexes +matchingDiagnostic :: ErrInfo -> Maybe DeclName +matchingDiagnostic ErrInfo{errInfoContext} = + asum $ map (unwrapMatch . (=~) errInfoTxt) errorMessageRegexes where - unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe (ExpectedSig, ActualSig, DeclName) - -- due to using (.|\n) in regex we have to drop the erroneous, but necessary ("." doesn't match newlines), match - unwrapMatch (_, _, _, [expect, actual, _, name]) = Just (expect, actual, name) - unwrapMatch _ = Nothing + unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe DeclName + unwrapMatch (_, _, _, [name]) = Just name + unwrapMatch _ = Nothing + + errInfoTxt = printOutputable errInfoContext -- | List of regexes that match various Error Messages errorMessageRegexes :: [Text] errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests - "Expected type: (.+)\n +Actual type: (.+)\n(.|\n)+In an equation for ‘(.+)’" - , "Couldn't match expected type ‘(.+)’ with actual type ‘(.+)’\n(.|\n)+In an equation for ‘(.+)’" - -- GHC >9.2 version of the first error regex - , "Expected: (.+)\n +Actual: (.+)\n(.|\n)+In an equation for ‘(.+)’" + "In an equation for ‘(.+)’:" ] -- | Given a String with the name of a declaration, GHC's "Expected Type", find the declaration that matches @@ -147,7 +228,7 @@ changeSigToCodeAction :: PluginId -> Uri -> ChangeSignature -> Command |? CodeAc changeSigToCodeAction (PluginId changeTypeSignatureId) uri ChangeSignature{..} = InR CodeAction { _title = mkChangeSigTitle declName actualType , _kind = Just (CodeActionKind_Custom ("quickfix." <> changeTypeSignatureId)) - , _diagnostics = Just [diagnostic] + , _diagnostics = Just [diagnostic ^. fdLspDiagnosticL ] , _isPreferred = Nothing , _disabled = Nothing , _edit = Just $ mkChangeSigEdit uri declSrcSpan (mkNewSignature declName actualType) diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index 57541b4736..72a2ab780e 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -5,7 +5,7 @@ import Data.Either (rights) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO -import Ide.Plugin.ChangeTypeSignature (errorMessageRegexes) +import Ide.Plugin.ChangeTypeSignature (Log (..), errorMessageRegexes) import qualified Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature import System.FilePath ((<.>), ()) import Test.Hls (CodeAction (..), Command, @@ -21,8 +21,7 @@ import Test.Hls (CodeAction (..), Command, getCodeActions, goldenWithHaskellDoc, knownBrokenForGhcVersions, - liftIO, - mkPluginTestDescriptor', + liftIO, mkPluginTestDescriptor, openDoc, runSessionWithServer, testCase, testGroup, toEither, type (|?), waitForBuildQueue, @@ -32,16 +31,19 @@ import Text.Regex.TDFA ((=~)) main :: IO () main = defaultTestRunner test -changeTypeSignaturePlugin :: PluginTestDescriptor () -changeTypeSignaturePlugin = mkPluginTestDescriptor' ChangeTypeSignature.descriptor "changeTypeSignature" +changeTypeSignaturePlugin :: PluginTestDescriptor Log +changeTypeSignaturePlugin = + mkPluginTestDescriptor + ChangeTypeSignature.descriptor + "changeTypeSignature" test :: TestTree test = testGroup "changeTypeSignature" [ testRegexes , codeActionTest "TExpectedActual" 4 11 - , knownBrokenForGhcVersions [GHC94 .. GHC912] "Error Message in 9.2+ does not provide enough info" $ + , knownBrokenForGhcVersions [GHC96 .. GHC912] "Error Message in 9.6+ does not provide enough info" $ codeActionTest "TRigidType" 4 14 - , codeActionTest "TRigidType2" 4 6 + , codeActionTest "TRigidType2" 4 8 , codeActionTest "TLocalBinding" 7 22 , codeActionTest "TLocalBindingShadow1" 11 8 , codeActionTest "TLocalBindingShadow2" 7 22 @@ -50,43 +52,17 @@ test = testGroup "changeTypeSignature" [ testRegexes :: TestTree testRegexes = testGroup "Regex Testing" [ - testRegexOne - , testRegexTwo - , testRegex921One - ] - -testRegexOne :: TestTree -testRegexOne = testGroup "Regex One" [ - regexTest "error1.txt" regex True - , regexTest "error2.txt" regex True - , regexTest "error3.txt" regex False - , regexTest "error4.txt" regex True - , regexTest "error5.txt" regex True + regexTest "TExpectedActual.txt" regex True + , regexTest "TLocalBinding.txt" regex True + , regexTest "TLocalBindingShadow1.txt" regex True + , regexTest "TLocalBindingShadow2.txt" regex True + -- Error message from GHC currently does not not provide enough info + , regexTest "TRigidType.txt" regex False + , regexTest "TRigidType2.txt" regex True ] where regex = errorMessageRegexes !! 0 -testRegexTwo :: TestTree -testRegexTwo = testGroup "Regex Two" [ - regexTest "error1.txt" regex False - , regexTest "error2.txt" regex False - , regexTest "error3.txt" regex True - , regexTest "error4.txt" regex False - , regexTest "error5.txt" regex False - ] - where - regex = errorMessageRegexes !! 1 - --- test ghc-9.2 error message regex -testRegex921One :: TestTree -testRegex921One = testGroup "Regex One" [ - regexTest "ghc921-error1.txt" regex True - , regexTest "ghc921-error2.txt" regex True - , regexTest "ghc921-error3.txt" regex True - ] - where - regex = errorMessageRegexes !! 2 - testDataDir :: FilePath testDataDir = "plugins" "hls-change-type-signature-plugin" "test" "testdata" @@ -123,8 +99,8 @@ regexTest :: FilePath -> Text -> Bool -> TestTree regexTest fp regex shouldPass = testCase fp $ do msg <- TIO.readFile (testDataDir fp) case (msg =~ regex :: (Text, Text, Text, [Text]), shouldPass) of - ((_, _, _, [_, _, _, _]), True) -> pure () - ((_, _, _, [_, _, _, _]), False) -> assertFailure $ "Unexpected match: " <> fp <> " with " <> T.unpack regex + ((_, _, _, [_]), True) -> pure () + ((_, _, _, [_]), False) -> assertFailure $ "Unexpected match: " <> fp <> " with " <> T.unpack regex (_, True) -> assertFailure $ "Failed to match: " <> fp <> " with " <> T.unpack regex (_, False) -> pure () diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt new file mode 100644 index 0000000000..6a8246a921 --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt @@ -0,0 +1,8 @@ +In the expression: go +In an equation for ‘fullSig’: +fullSig + = go + where + go = head . reverse + + diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt new file mode 100644 index 0000000000..3f31dc48b9 --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt @@ -0,0 +1,8 @@ +Probable cause: ‘forM’ is applied to too few arguments +In the expression: forM +In an equation for ‘test’: test = forM +In the expression: + let + test :: Int -> Int + test = forM + in x + 1 diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt new file mode 100644 index 0000000000..ef782e8aec --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt @@ -0,0 +1,4 @@ +Probable cause: ‘forM’ is applied to too few arguments +In the expression: forM +In an equation for ‘test’: test = forM + diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt new file mode 100644 index 0000000000..bea2526eb9 --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt @@ -0,0 +1,9 @@ +Probable cause: ‘forM’ is applied to too few arguments +In the expression: forM +In an equation for ‘test’: test = forM +In the expression: + let + test :: Int -> Int + test = forM + in test x [GHC-83865] + diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt new file mode 100644 index 0000000000..f9e78c97ae --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt @@ -0,0 +1,5 @@ +In the expression: go . head . reverse +Relevant bindings include + test :: a -> Int + (bound at /home/sgillespie/dev/haskell/haskell-language-server/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.hs:4:1) [GHC-25897] + diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt new file mode 100644 index 0000000000..343129a942 --- /dev/null +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt @@ -0,0 +1,6 @@ +In the expression: head +In an equation for ‘test’: test = head +Relevant bindings include + test :: a -> Int + (bound at /home/sgillespie/dev/haskell/haskell-language-server/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.hs:4:1) [GHC-25897] + diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt deleted file mode 100644 index 37f0aa4a81..0000000000 --- a/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt +++ /dev/null @@ -1,6 +0,0 @@ - • Couldn't match type ‘Int’ - with ‘Data.HashSet.Internal.HashSet Int’ - Expected type: Int -> Int - Actual type: Data.HashSet.Internal.HashSet Int -> Int - • In the expression: head . toList - In an equation for ‘test’: test = head . toList diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt deleted file mode 100644 index 497f8350a5..0000000000 --- a/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt +++ /dev/null @@ -1,6 +0,0 @@ - • Couldn't match type ‘b0 -> t0 a0 -> b0’ with ‘Int’ - Expected type: Int -> Int - Actual type: (b0 -> a0 -> b0) -> b0 -> t0 a0 -> b0 - • Probable cause: ‘foldl’ is applied to too few arguments - In the expression: foldl - In an equation for ‘test’: test = foldl diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt deleted file mode 100644 index 0cbddad7c4..0000000000 --- a/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt +++ /dev/null @@ -1,10 +0,0 @@ - • Couldn't match expected type ‘Int’ with actual type ‘[Int]’ - • In the expression: map (+ x) [1, 2, 3] - In an equation for ‘test’: - test x - = map (+ x) [1, 2, 3] - where - go = head . reverse - | -152 | test x = map (+ x) [1,2,3] - | ^^^^^^^^^^^^^^^^^ diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt deleted file mode 100644 index 323cf7d4db..0000000000 --- a/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt +++ /dev/null @@ -1,19 +0,0 @@ - • Couldn't match type ‘a’ with ‘[[Int]]’ - ‘a’ is a rigid type variable bound by - the type signature for: - test :: forall a. Ord a => a -> Int - at src/Ide/Plugin/ChangeTypeSignature.hs:154:1-25 - Expected type: a -> Int - Actual type: [[Int]] -> Int - • In the expression: go . head . reverse - In an equation for ‘test’: - test - = go . head . reverse - where - go = head . reverse - • Relevant bindings include - test :: a -> Int - (bound at src/Ide/Plugin/ChangeTypeSignature.hs:155:1) - | -155 | test = go . head . reverse - | ^^^^^^^^^^^^^^^^^^^ diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt deleted file mode 100644 index a7a5d9a20b..0000000000 --- a/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt +++ /dev/null @@ -1,15 +0,0 @@ - • Couldn't match type ‘(a0 -> m0 b0) -> m0 (t0 b0)’ with ‘Int’ - Expected type: Int -> Int - Actual type: t0 a0 -> (a0 -> m0 b0) -> m0 (t0 b0) - • Probable cause: ‘forM’ is applied to too few arguments - In the expression: forM - In an equation for ‘test’: test = forM - In an equation for ‘implicit’: - implicit - = return OpTEmpty - where - test :: Int -> Int - test = forM - | -82 | test = forM - | ^^^^ diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 5ff79e2e37..3f902ef80c 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -1,10 +1,15 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Class.CodeAction where +module Ide.Plugin.Class.CodeAction ( + addMethodPlaceholders, + codeAction, +) where +import Control.Arrow ((>>>)) import Control.Lens hiding (List, use) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Extra @@ -13,8 +18,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Maybe import Data.Aeson hiding (Null) -import Data.Bifunctor (second) -import Data.Either.Extra (rights) import Data.List import Data.List.Extra (nubOrdOn) import qualified Data.Map.Strict as Map @@ -23,13 +26,19 @@ import Data.Maybe (isNothing, listToMaybe, import qualified Data.Set as Set import qualified Data.Text as T import Development.IDE -import Development.IDE.Core.Compile (sourceTypecheck) import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (fromCurrentRange) import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Error (TcRnMessage (..), + _TcRnMessage, + msgEnvelopeErrorL, + stripTcRnMessageContext) import Development.IDE.GHC.Compat.Util import Development.IDE.Spans.AtPoint (pointCommand) +import GHC.Iface.Ext.Types (ContextInfo (..), + HieAST (..), Identifier, + IdentifierDetails (..)) import Ide.Plugin.Class.ExactPrint import Ide.Plugin.Class.Types import Ide.Plugin.Class.Utils @@ -80,23 +89,25 @@ addMethodPlaceholders _ state _ param@AddMinimalMethodsParams{..} = do -- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is -- sensitive to the format of diagnostic messages from GHC. codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction -codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do +codeAction recorder state plId (CodeActionParams _ _ docId caRange _) = do verTxtDocId <- liftIO $ runAction "classplugin.codeAction.getVersionedTextDoc" state $ getVersionedTextDoc docId nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) - actions <- join <$> mapM (mkActions nfp verTxtDocId) methodDiags - pure $ InL actions + activeDiagnosticsInRange (shakeExtras state) nfp caRange + >>= \case + Nothing -> pure $ InL [] + Just fileDiags -> do + actions <- join <$> mapM (mkActions nfp verTxtDocId) (methodDiags fileDiags) + pure $ InL actions where - diags = context ^. L.diagnostics - - ghcDiags = filter (\d -> d ^. L.source == Just sourceTypecheck) diags - methodDiags = filter (\d -> isClassMethodWarning (d ^. L.message)) ghcDiags + methodDiags fileDiags = + mapMaybe (\d -> (d,) <$> isClassMethodWarning (d ^. fdStructuredMessageL)) fileDiags mkActions :: NormalizedFilePath -> VersionedTextDocumentIdentifier - -> Diagnostic + -> (FileDiagnostic, ClassMinimalDef) -> ExceptT PluginError (HandlerM Ide.Plugin.Config.Config) [Command |? CodeAction] - mkActions docPath verTxtDocId diag = do + mkActions docPath verTxtDocId (diag, classMinDef) = do (HAR {hieAst = ast}, pmap) <- runActionE "classplugin.findClassIdentifier.GetHieAst" state $ useWithStaleE GetHieAst docPath instancePosition <- handleMaybe (PluginInvalidUserState "fromCurrentRange") $ @@ -108,21 +119,19 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do $ useE GetInstanceBindTypeSigs docPath (tmrTypechecked -> gblEnv ) <- runActionE "classplugin.codeAction.TypeCheck" state $ useE TypeCheck docPath (hscEnv -> hsc) <- runActionE "classplugin.codeAction.GhcSession" state $ useE GhcSession docPath - implemented <- findImplementedMethods ast instancePosition - logWith recorder Info (LogImplementedMethods cls implemented) + logWith recorder Debug (LogImplementedMethods (hsc_dflags hsc) cls classMinDef) pure $ concatMap mkAction $ nubOrdOn snd $ filter ((/=) mempty . snd) - $ fmap (second (filter (\(bind, _) -> bind `notElem` implemented))) - $ mkMethodGroups hsc gblEnv range sigs cls + $ mkMethodGroups hsc gblEnv range sigs classMinDef where - range = diag ^. L.range + range = diag ^. fdLspDiagnosticL . L.range - mkMethodGroups :: HscEnv -> TcGblEnv -> Range -> [InstanceBindTypeSig] -> Class -> [MethodGroup] - mkMethodGroups hsc gblEnv range sigs cls = minimalDef <> [allClassMethods] + mkMethodGroups :: HscEnv -> TcGblEnv -> Range -> [InstanceBindTypeSig] -> ClassMinimalDef -> [MethodGroup] + mkMethodGroups hsc gblEnv range sigs classMinDef = minimalDef <> [allClassMethods] where - minimalDef = minDefToMethodGroups hsc gblEnv range sigs $ classMinimalDef cls + minimalDef = minDefToMethodGroups hsc gblEnv range sigs classMinDef allClassMethods = ("all missing methods", makeMethodDefinitions hsc gblEnv range sigs) mkAction :: MethodGroup -> [Command |? CodeAction] @@ -163,25 +172,6 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do <=< nodeChildren ) - findImplementedMethods - :: HieASTs a - -> Position - -> ExceptT PluginError (HandlerM Ide.Plugin.Config.Config) [T.Text] - findImplementedMethods asts instancePosition = do - pure - $ concat - $ pointCommand asts instancePosition - $ map (T.pack . getOccString) . rights . findInstanceValBindIdentifiers - - -- | Recurses through the given AST to find identifiers which are - -- 'InstanceValBind's. - findInstanceValBindIdentifiers :: HieAST a -> [Identifier] - findInstanceValBindIdentifiers ast = - let valBindIds = Map.keys - . Map.filter (any isInstanceValBind . identInfo) - $ getNodeIds ast - in valBindIds <> concatMap findInstanceValBindIdentifiers (nodeChildren ast) - findClassFromIdentifier docPath (Right name) = do (hscEnv -> hscenv, _) <- runActionE "classplugin.findClassFromIdentifier.GhcSessionDeps" state $ useWithStaleE GhcSessionDeps docPath @@ -203,12 +193,15 @@ isClassNodeIdentifier :: Identifier -> IdentifierDetails a -> Bool isClassNodeIdentifier (Right i) ident | 'C':':':_ <- unpackFS $ occNameFS $ occName i = (isNothing . identType) ident && Use `Set.member` identInfo ident isClassNodeIdentifier _ _ = False -isClassMethodWarning :: T.Text -> Bool -isClassMethodWarning = T.isPrefixOf "• No explicit implementation for" +isClassMethodWarning :: StructuredMessage -> Maybe ClassMinimalDef +isClassMethodWarning message = case message ^? _SomeStructuredMessage . msgEnvelopeErrorL . _TcRnMessage of + Nothing -> Nothing + Just tcRnMessage -> isUnsatisfiedMinimalDefWarning tcRnMessage -isInstanceValBind :: ContextInfo -> Bool -isInstanceValBind (ValBind InstanceBind _ _) = True -isInstanceValBind _ = False +isUnsatisfiedMinimalDefWarning :: TcRnMessage -> Maybe ClassMinimalDef +isUnsatisfiedMinimalDefWarning = stripTcRnMessageContext >>> \case + TcRnUnsatisfiedMinimalDef classMinDef -> Just classMinDef + _ -> Nothing type MethodSignature = T.Text type MethodName = T.Text diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index 71deb9c1d8..bb0994442a 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -46,10 +46,8 @@ makeMethodDecl df (mName, sig) = do #if MIN_VERSION_ghc_exactprint(1,10,0) addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> Located (HsModule GhcPs) -#elif MIN_VERSION_ghc(9,5,0) -addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located (HsModule GhcPs)) #else -addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule) +addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located (HsModule GhcPs)) #endif addMethodDecls ps mDecls range withSig | withSig = go (concatMap (\(decl, sig) -> [sig, decl]) mDecls) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index e66632c3c6..1669aba43d 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -112,15 +112,15 @@ instance NFData InstanceBindLensResult where type instance RuleResult GetInstanceBindLens = InstanceBindLensResult data Log - = LogImplementedMethods Class [T.Text] + = LogImplementedMethods DynFlags Class ClassMinimalDef | LogShake Shake.Log instance Pretty Log where pretty = \case - LogImplementedMethods cls methods -> - pretty ("Detected implemented methods for class" :: String) + LogImplementedMethods dflags cls methods -> + pretty ("The following methods are missing" :: String) <+> pretty (show (getOccString cls) <> ":") -- 'show' is used here to add quotes around the class name - <+> pretty methods + <+> pretty (showSDoc dflags $ ppr methods) LogShake log -> pretty log data BindInfo = BindInfo diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs index 6fa799b8d5..915a98d607 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/ASTPreProcess.hs @@ -19,7 +19,11 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Semigroup (First (First, getFirst)) import Data.Semigroup.Foldable (foldlM1) import qualified Data.Set as Set -import Development.IDE.GHC.Compat hiding (nodeInfo) +import Development.IDE.GHC.Compat +import GHC.Iface.Ext.Types (ContextInfo (..), HieAST (..), + Identifier, IdentifierDetails (..), + NodeInfo (nodeIdentifiers), Span) +import GHC.Iface.Ext.Utils (RefMap, flattenAst) import Prelude hiding (span) {-| diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index 86d5923011..2391a35e1a 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -39,18 +39,17 @@ import qualified Data.Vector as V import Development.IDE import Development.IDE.Core.Rules (toIdeResult) import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.GHC.Compat (HieAST (..), - HieASTs (getAsts), RefMap) import Development.IDE.GHC.Compat.Util import GHC.Generics (Generic) +import GHC.Iface.Ext.Types (HieAST (..), HieASTs (..)) +import GHC.Iface.Ext.Utils (RefMap) import Ide.Plugin.CodeRange.ASTPreProcess (CustomNodeType (..), PreProcessEnv (..), isCustomNode, preProcessAST) -import Language.LSP.Protocol.Types (FoldingRangeKind (FoldingRangeKind_Comment, FoldingRangeKind_Imports, FoldingRangeKind_Region)) - import Language.LSP.Protocol.Lens (HasEnd (end), HasStart (start)) +import Language.LSP.Protocol.Types (FoldingRangeKind (FoldingRangeKind_Comment, FoldingRangeKind_Imports, FoldingRangeKind_Region)) import Prelude hiding (log) data Log = LogShake Shake.Log diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs index 87553bfeba..30d43de005 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval.hs @@ -27,7 +27,7 @@ import Language.LSP.Protocol.Message -- |Plugin descriptor descriptor :: Recorder (WithPriority Eval.Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = - (defaultPluginDescriptor plId "Provies code action and lens to evaluate expressions in doctest comments") + (defaultPluginDescriptor plId "Provides code action and lens to evaluate expressions in doctest comments") { pluginHandlers = mconcat [ mkPluginHandler SMethod_TextDocumentCodeAction (Handlers.codeAction recorder) , mkPluginHandler SMethod_TextDocumentCodeLens (Handlers.codeLens recorder) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index cc80e91f77..1f19b5b476 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -41,14 +41,10 @@ import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE.Core.FileStore (getUriContents) +import Development.IDE.Core.FileStore (getUriContents, setSomethingModified) import Development.IDE.Core.Rules (IdeState, runAction) -import Development.IDE.Core.RuleTypes (LinkableResult (linkableHomeMod), - TypeCheck (..), - tmrTypechecked) -import Development.IDE.Core.Shake (useNoFile_, use_, - uses_) +import Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_) import Development.IDE.GHC.Compat hiding (typeKind, unitState) import Development.IDE.GHC.Compat.Util (OverridingBool (..)) @@ -76,17 +72,18 @@ import GHC (ClsInst, import Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable), GetModSummary (GetModSummary), - GetModuleGraph (GetModuleGraph), + GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints), GhcSessionDeps (GhcSessionDeps), - ModSummaryResult (msrModSummary)) -import Development.IDE.Core.Shake (VFSModified (VFSUnmodified)) + ModSummaryResult (msrModSummary), + LinkableResult (linkableHomeMod), + TypeCheck (..), + tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..)) import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule)) import qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) import Data.List.Extra (unsnoc) -import Development.IDE.Core.FileStore (setSomethingModified) import Development.IDE.Core.PluginUtils import Development.IDE.Types.Shake (toKey) import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) @@ -256,7 +253,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do ms <- msrModSummary <$> use_ GetModSummary nfp deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp - linkables_needed <- transitiveDeps <$> useNoFile_ GetModuleGraph <*> pure nfp + linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed) -- We unset the global rdr env in mi_globals when we generate interfaces -- See Note [Clearing mi_globals after generating an iface] diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs index 3d896f1da1..d01ddbc55c 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs @@ -73,11 +73,7 @@ apiAnnComments' pm = do #endif span) c) where -#if MIN_VERSION_ghc(9,5,0) getEpaComments :: Development.IDE.GHC.Compat.Located (HsModule GhcPs) -> [LEpaComment] -#else - getEpaComments :: Development.IDE.GHC.Compat.Located HsModule -> [LEpaComment] -#endif getEpaComments = toListOf biplate pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 77b133ef92..9498076511 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -77,9 +77,7 @@ showErr e = $ bagToList $ fmap (vcat . unDecorated . diagnosticMessage -#if MIN_VERSION_ghc(9,5,0) (defaultDiagnosticOpts @GhcMessage) -#endif . errMsgDiagnostic) $ getMessages msgs _ -> diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 7338b4384f..03416c6902 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -84,8 +84,7 @@ tests = evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero" -- The default for marking exceptions is False , goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs" , goldenWithEval "Evaluate a type with :kind!" "T10" "hs" - , goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" - (if ghcVersion >= GHC94 then "ghc94.expected" else "expected") + , goldenWithEval "Reports an error for an incorrect type with :kind!" "T11" "hs" , goldenWithEval "Shows a kind with :kind" "T12" "hs" , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs" , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 @@ -138,7 +137,6 @@ tests = GHC910 -> "ghc910.expected" GHC98 -> "ghc98.expected" GHC96 -> "ghc96.expected" - GHC94 -> "ghc94.expected" , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs" , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs" , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs" @@ -219,7 +217,7 @@ tests = knownBrokenInWindowsBeforeGHC912 msg = foldl (.) id [ knownBrokenInSpecificEnv [GhcVer ghcVer, HostOS Windows] msg - | ghcVer <- [GHC94 .. GHC910] + | ghcVer <- [GHC96 .. GHC910] ] goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree diff --git a/plugins/hls-eval-plugin/test/testdata/T11.ghc94.expected.hs b/plugins/hls-eval-plugin/test/testdata/T11.ghc94.expected.hs deleted file mode 100644 index 63d0ed8a07..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T11.ghc94.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T11 where - --- >>> :kind! A --- Not in scope: type constructor or class `A' diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs index e3208e37f5..089779ea2b 100644 --- a/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs @@ -10,4 +10,12 @@ module TProperty where -- errorEmptyList, called at libraries/ghc-internal/src/GHC/Internal/List.hs:96:11 in ghc-internal:GHC.Internal.List -- badHead, called at libraries/ghc-internal/src/GHC/Internal/List.hs:90:28 in ghc-internal:GHC.Internal.List -- head, called at :1:27 in interactive:Ghci2 +-- HasCallStack backtrace: +-- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception +-- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:204:5 in ghc-internal:GHC.Internal.Exception +-- error, called at libraries/ghc-internal/src/GHC/Internal/List.hs:2030:3 in ghc-internal:GHC.Internal.List +-- errorEmptyList, called at libraries/ghc-internal/src/GHC/Internal/List.hs:96:11 in ghc-internal:GHC.Internal.List +-- badHead, called at libraries/ghc-internal/src/GHC/Internal/List.hs:90:28 in ghc-internal:GHC.Internal.List +-- head, called at :1:27 in interactive:Ghci2 +-- -- [] diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index f24f849476..17634491fe 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -472,11 +472,7 @@ extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do not $ any (\e -> ("module " ++ moduleNameString name) == e) exports isExplicitImport :: ImportDecl GhcRn -> Bool -#if MIN_VERSION_ghc(9,5,0) isExplicitImport ImportDecl {ideclImportList = Just (Exactly, _)} = True -#else -isExplicitImport ImportDecl {ideclHiding = Just (False, _)} = True -#endif isExplicitImport _ = False -- This number is somewhat arbitrarily chosen. Ideally the protocol would tell us these things, @@ -528,11 +524,7 @@ abbreviateImportTitleWithoutModule = abbreviateImportTitle . T.dropWhile (/= '(' filterByImport :: ImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo]) -#if MIN_VERSION_ghc(9,5,0) filterByImport (ImportDecl{ideclImportList = Just (_, L _ names)}) -#else -filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)}) -#endif avails = -- if there is a function defined in the current module and is used -- i.e. if a function is not reexported but defined in current @@ -549,22 +541,12 @@ filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)}) filterByImport _ _ = Nothing constructImport :: ImportDecl GhcRn -> ImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> ImportDecl GhcRn -#if MIN_VERSION_ghc(9,5,0) constructImport ImportDecl{ideclQualified = qualified, ideclImportList = origHiding} imd@ImportDecl{ideclImportList = Just (hiding, L _ names)} -#else -constructImport ImportDecl{ideclQualified = qualified, ideclHiding = origHiding} imd@ImportDecl{ideclHiding = Just (hiding, L _ names)} -#endif (newModuleName, avails) = imd { ideclName = noLocA newModuleName -#if MIN_VERSION_ghc(9,5,0) , ideclImportList = if isNothing origHiding && qualified /= NotQualified then Nothing else Just (hiding, noLocA newNames) -#else - , ideclHiding = if isNothing origHiding && qualified /= NotQualified - then Nothing - else Just (hiding, noLocA newNames) -#endif } where newNames = filter (\n -> any (n `containsAvail`) avails) names -- Check if a name is exposed by AvailInfo (the available information of a module) diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index 2d711979c3..a111e9062b 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -58,8 +58,7 @@ import Development.IDE.GHC.Compat (FieldLabel (flSelector), HsExpr (HsApp, HsVar, XExpr), HsFieldBind (hfbLHS), HsRecFields (..), - HsWrap (HsWrap), - Identifier, LPat, + HsWrap (HsWrap), LPat, Located, NamedThing (getName), Outputable, @@ -82,13 +81,15 @@ import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns pattern RealSrcSpan, plusUFM_C, unitUFM) import Development.IDE.GHC.Util (getExtensions, - printOutputable) + printOutputable, + stripOccNamePrefix) import Development.IDE.Graph (RuleResult) import Development.IDE.Graph.Classes (Hashable, NFData) import Development.IDE.Spans.Pragmas (NextPragmaInfo (..), getFirstPragma, insertNewPragma) import GHC.Generics (Generic) +import GHC.Iface.Ext.Types (Identifier) import Ide.Logger (Priority (..), cmapWithPrio, logWith, (<+>)) @@ -151,10 +152,17 @@ descriptor recorder plId = codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do nfp <- getNormalizedFilePathE (docId ^. L.uri) - CRR {crCodeActions, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp + CRR {crCodeActions, crCodeActionResolve, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp -- All we need to build a code action is the list of extensions, and a int to -- allow us to resolve it later. - let actions = map (mkCodeAction enabledExtensions) (RangeMap.filterByRange range crCodeActions) + let recordUids = [ uid + | uid <- RangeMap.filterByRange range crCodeActions + , Just record <- [IntMap.lookup uid crCodeActionResolve] + -- Only fully saturated constructor applications can be + -- converted to the record syntax through the code action + , isConvertible record + ] + let actions = map (mkCodeAction enabledExtensions) recordUids pure $ InL actions where mkCodeAction :: [Extension] -> Int -> Command |? CodeAction @@ -169,6 +177,11 @@ codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do , _data_ = Just $ toJSON uid } + isConvertible :: RecordInfo -> Bool + isConvertible = \case + RecordInfoApp _ (RecordAppExpr Unsaturated _ _) -> False + _ -> True + codeActionResolveProvider :: ResolveFunction IdeState Int 'Method_CodeActionResolve codeActionResolveProvider ideState pId ca uri uid = do nfp <- getNormalizedFilePathE uri @@ -226,7 +239,7 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen -- checks if 'a' is equal to 'Name' if the 'Either' is 'Right a', otherwise return 'False' nameEq = either (const False) ((==) name) in fmap fst $ find (nameEq . snd) filteredLocations - valueWithLoc = [ (T.pack $ printName name, findLocation name defnLocs') | name <- names' ] + valueWithLoc = [ (stripOccNamePrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ] -- use `, ` to separate labels with definition location label = intersperse (mkInlayHintLabelPart (", ", Nothing)) $ fmap mkInlayHintLabelPart valueWithLoc pure $ InlayHint { _position = currentEnd -- at the end of dotdot @@ -253,7 +266,7 @@ inlayHintPosRecProvider _ state _pId InlayHintParams {_textDocument = TextDocume pure $ InL (concatMap (mkInlayHints nameMap pm) records) where mkInlayHints :: UniqFM Name [Name] -> PositionMapping -> RecordInfo -> [InlayHint] - mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr _ fla)) = + mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr _ _ fla)) = let textEdits = renderRecordInfoAsTextEdit nameMap record in mapMaybe (mkInlayHint textEdits pm) fla mkInlayHints _ _ _ = [] @@ -275,7 +288,7 @@ inlayHintPosRecProvider _ state _pId InlayHintParams {_textDocument = TextDocume , _data_ = Nothing } - mkInlayHintLabelPart name loc = InlayHintLabelPart (printOutputable (pprNameUnqualified name) <> "=") Nothing loc Nothing + mkInlayHintLabelPart name loc = InlayHintLabelPart (printFieldName (pprNameUnqualified name) <> "=") Nothing loc Nothing mkTitle :: [Extension] -> Text mkTitle exts = "Expand record wildcard" @@ -379,7 +392,16 @@ instance Show CollectNamesResult where type instance RuleResult CollectNames = CollectNamesResult -data RecordAppExpr = RecordAppExpr (LHsExpr GhcTc) [(Located FieldLabel, HsExpr GhcTc)] +data Saturated = Saturated | Unsaturated + deriving (Generic) + +instance NFData Saturated + +data RecordAppExpr + = RecordAppExpr + Saturated -- ^ Is the DataCon application fully saturated or partially applied? + (LHsExpr GhcTc) + [(Located FieldLabel, HsExpr GhcTc)] deriving (Generic) data RecordInfo @@ -389,10 +411,10 @@ data RecordInfo deriving (Generic) instance Pretty RecordInfo where - pretty (RecordInfoPat ss p) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable p) - pretty (RecordInfoCon ss e) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable e) - pretty (RecordInfoApp ss (RecordAppExpr _ fla)) - = pretty (printOutputable ss) <> ":" <+> hsep (map (pretty . printOutputable) fla) + pretty (RecordInfoPat ss p) = pretty (printFieldName ss) <> ":" <+> pretty (printOutputable p) + pretty (RecordInfoCon ss e) = pretty (printFieldName ss) <> ":" <+> pretty (printOutputable e) + pretty (RecordInfoApp ss (RecordAppExpr _ _ fla)) + = pretty (printFieldName ss) <> ":" <+> hsep (map (pretty . printOutputable) fla) recordInfoToRange :: RecordInfo -> Range recordInfoToRange (RecordInfoPat ss _) = realSrcSpanToRange ss @@ -499,7 +521,7 @@ processRecordFlds flds = flds { rec_dotdot = Nothing , rec_flds = puns' } showRecordPat :: Outputable (Pat GhcTc) => UniqFM Name [Name] -> Pat GhcTc -> Maybe Text -showRecordPat names = fmap printOutputable . mapConPatDetail (\case +showRecordPat names = fmap printFieldName . mapConPatDetail (\case RecCon flds -> Just $ RecCon (preprocessRecordPat names flds) _ -> Nothing) @@ -536,11 +558,11 @@ showRecordConFlds (RecordCon _ _ flds) = showRecordConFlds _ = Nothing showRecordApp :: RecordAppExpr -> Maybe Text -showRecordApp (RecordAppExpr recConstr fla) +showRecordApp (RecordAppExpr _ recConstr fla) = Just $ printOutputable recConstr <> " { " <> T.intercalate ", " (showFieldWithArg <$> fla) <> " }" - where showFieldWithArg (field, arg) = printOutputable field <> " = " <> printOutputable arg + where showFieldWithArg (field, arg) = printFieldName field <> " = " <> printOutputable arg collectRecords :: GenericQ [RecordInfo] collectRecords = everythingBut (<>) (([], False) `mkQ` getRecPatterns `extQ` getRecCons) @@ -588,8 +610,14 @@ getRecCons expr@(unLoc -> app@(HsApp _ _ _)) = getFields :: HsExpr GhcTc -> [LHsExpr GhcTc] -> Maybe RecordAppExpr getFields (HsApp _ constr@(unLoc -> expr) arg) args - | not (null fls) - = Just (RecordAppExpr constr labelWithArgs) + | not (null fls) = Just $ + -- Code action is only valid if the constructor application is fully + -- saturated, but we still want to display the inlay hints for partially + -- applied constructors + RecordAppExpr + (if length fls <= length args + 1 then Saturated else Unsaturated) + constr + labelWithArgs where fls = getExprFields expr labelWithArgs = zipWith mkLabelWithArg fls (arg : args) mkLabelWithArg label arg = (L (getLoc arg) label, unLoc arg) @@ -614,3 +642,7 @@ getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds)) mkRecInfo pat = [ RecordInfoPat realSpan' (unLoc pat) | RealSrcSpan realSpan' _ <- [ getLoc pat ]] getRecPatterns _ = ([], False) + +printFieldName :: Outputable a => a -> Text +printFieldName = stripOccNamePrefix . printOutputable + diff --git a/plugins/hls-explicit-record-fields-plugin/test/Main.hs b/plugins/hls-explicit-record-fields-plugin/test/Main.hs index 1a4fa5d2ba..82ef449a25 100644 --- a/plugins/hls-explicit-record-fields-plugin/test/Main.hs +++ b/plugins/hls-explicit-record-fields-plugin/test/Main.hs @@ -36,6 +36,7 @@ test = testGroup "explicit-fields" , mkTestNoAction "Puns" "Puns" 12 10 12 31 , mkTestNoAction "Infix" "Infix" 11 11 11 31 , mkTestNoAction "Prefix" "Prefix" 10 11 10 28 + , mkTestNoAction "PartiallyAppliedCon" "PartiallyAppliedCon" 7 8 7 12 , mkTest "PolymorphicRecordConstruction" "PolymorphicRecordConstruction" 15 5 15 15 ] , testGroup "inlay hints" @@ -56,6 +57,24 @@ test = testGroup "explicit-fields" , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)" , _paddingLeft = Just True }] + , mkInlayHintsTest "ConstructionDuplicateRecordFields" Nothing 16 $ \ih -> do + let mkLabelPart' = mkLabelPartOffsetLength "ConstructionDuplicateRecordFields" + foo <- mkLabelPart' 13 6 "foo" + bar <- mkLabelPart' 14 6 "bar" + baz <- mkLabelPart' 15 6 "baz" + (@?=) ih + [defInlayHint { _position = Position 16 14 + , _label = InR [ foo, commaPart + , bar, commaPart + , baz + ] + , _textEdits = Just [ mkLineTextEdit "MyRec {foo, bar, baz}" 16 5 15 + , mkPragmaTextEdit 3 -- Not 2 of the DuplicateRecordFields pragma + ] + , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)" + , _paddingLeft = Just True + }] + , mkInlayHintsTest "PositionalConstruction" Nothing 15 $ \ih -> do let mkLabelPart' = mkLabelPartOffsetLengthSub1 "PositionalConstruction" foo <- mkLabelPart' 5 4 "foo=" @@ -81,6 +100,31 @@ test = testGroup "explicit-fields" , _paddingLeft = Nothing } ] + , mkInlayHintsTest "PositionalConstructionDuplicateRecordFields" Nothing 15 $ \ih -> do + let mkLabelPart' = mkLabelPartOffsetLengthSub1 "PositionalConstructionDuplicateRecordFields" + foo <- mkLabelPart' 5 4 "foo=" + bar <- mkLabelPart' 6 4 "bar=" + baz <- mkLabelPart' 7 4 "baz=" + (@?=) ih + [ defInlayHint { _position = Position 15 11 + , _label = InR [ foo ] + , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] + , _tooltip = Just $ InL "Expand positional record" + , _paddingLeft = Nothing + } + , defInlayHint { _position = Position 15 13 + , _label = InR [ bar ] + , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] + , _tooltip = Just $ InL "Expand positional record" + , _paddingLeft = Nothing + } + , defInlayHint { _position = Position 15 15 + , _label = InR [ baz ] + , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] + , _tooltip = Just $ InL "Expand positional record" + , _paddingLeft = Nothing + } + ] , mkInlayHintsTest "HsExpanded1" Nothing 17 $ \ih -> do let mkLabelPart' = mkLabelPartOffsetLength "HsExpanded1" foo <- mkLabelPart' 11 4 "foo" @@ -101,6 +145,16 @@ test = testGroup "explicit-fields" , _tooltip = Just $ InL "Expand positional record" , _paddingLeft = Nothing }] + , mkInlayHintsTest "HsExpanded1DuplicateRecordFields" (Just " (positional)") 13 $ \ih -> do + let mkLabelPart' = mkLabelPartOffsetLengthSub1 "HsExpanded1DuplicateRecordFields" + foo <- mkLabelPart' 11 4 "foo=" + (@?=) ih + [defInlayHint { _position = Position 13 21 + , _label = InR [ foo ] + , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 13 15 22 ] + , _tooltip = Just $ InL "Expand positional record" + , _paddingLeft = Nothing + }] , mkInlayHintsTest "HsExpanded2" Nothing 23 $ \ih -> do let mkLabelPart' = mkLabelPartOffsetLength "HsExpanded2" bar <- mkLabelPart' 14 4 "bar" diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/ConstructionDuplicateRecordFields.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/ConstructionDuplicateRecordFields.hs new file mode 100644 index 0000000000..420711f0da --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/ConstructionDuplicateRecordFields.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DuplicateRecordFields #-} +module Construction where + +data MyRec = MyRec + { foo :: Int + , bar :: Int + , baz :: Char + } + +convertMe :: () -> MyRec +convertMe _ = + let foo = 3 + bar = 5 + baz = 'a' + in MyRec {..} diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/HsExpanded1DuplicateRecordFields.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/HsExpanded1DuplicateRecordFields.hs new file mode 100644 index 0000000000..1e37d14668 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/HsExpanded1DuplicateRecordFields.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE DuplicateRecordFields #-} +module HsExpanded1DuplicateRecordFields where +import Prelude + +ifThenElse :: Int -> Int -> Int -> Int +ifThenElse x y z = x + y + z + +data MyRec = MyRec + { foo :: Int } + +myRecExample = MyRec 5 + +convertMe :: Int +convertMe = + if (let MyRec {..} = myRecExample + in foo) then 1 else 2 diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/PositionalConstructionDuplicateRecordFields.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/PositionalConstructionDuplicateRecordFields.hs new file mode 100644 index 0000000000..5227af9a83 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/PositionalConstructionDuplicateRecordFields.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE DuplicateRecordFields #-} +module PositionalConstruction where + +data MyRec = MyRec + { foo :: Int + , bar :: Int + , baz :: Char + } + +convertMe :: () -> MyRec +convertMe _ = + let a = 3 + b = 5 + c = 'a' + in MyRec a b c + diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/noop/PartiallyAppliedCon.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/noop/PartiallyAppliedCon.hs new file mode 100644 index 0000000000..2f6f52e30b --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/noop/PartiallyAppliedCon.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Haskell2010 #-} + +module PartiallyAppliedCon where + +data T = MkT { fa :: Int, fb :: Char } + +foo :: Int -> Char -> T +foo x = MkT x diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index 7d77d7ae87..f5687a9db3 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -26,18 +26,13 @@ import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,5,0) import qualified Data.List.NonEmpty as NE -#endif - -#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,9,0) -import GHC.Parser.Annotation (TokenLocation (..)) -#endif #if !MIN_VERSION_ghc(9,9,0) import GHC.Parser.Annotation (Anchor (Anchor), AnchorOperation (MovedAnchor), SrcSpanAnn' (SrcSpanAnn), + TokenLocation (..), spanAsAnchor) #endif @@ -106,6 +101,7 @@ h98ToGADTConDecl :: h98ToGADTConDecl dataName tyVars ctxt = \case ConDeclH98{..} -> ConDeclGADT + #if MIN_VERSION_ghc(9,11,0) (AnnConDeclGADT [] [] NoEpUniTok) #elif MIN_VERSION_ghc(9,9,0) @@ -113,13 +109,10 @@ h98ToGADTConDecl dataName tyVars ctxt = \case #else con_ext #endif -#if MIN_VERSION_ghc(9,5,0) + (NE.singleton con_name) -#else - [con_name] -#endif -#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,9,0) +#if !MIN_VERSION_ghc(9,9,0) (L NoTokenLoc HsNormalTok) #endif -- Ignore all existential type variable since GADT not needed diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 9621f894e3..210e9f3910 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -5,7 +5,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} @@ -54,15 +53,20 @@ import Development.IDE.Core.FileStore (getVersione import Development.IDE.Core.Rules (defineNoFile, getParsedModuleWithComments) import Development.IDE.Core.Shake (getDiagnostics) + +#if APPLY_REFACT import qualified Refact.Apply as Refact import qualified Refact.Types as Refact +#if !MIN_VERSION_apply_refact(0,12,0) +import System.Environment (setEnv, + unsetEnv) +#endif +#endif import Development.IDE.GHC.Compat (DynFlags, - WarningFlag (Opt_WarnUnrecognisedPragmas), extensionFlags, ms_hspp_opts, - topDir, - wopt) + topDir) import qualified Development.IDE.GHC.Compat.Util as EnumSet #if MIN_GHC_API_VERSION(9,4,0) @@ -105,6 +109,7 @@ import Language.LSP.Protocol.Types hiding (Null) import qualified Language.LSP.Protocol.Types as LSP +import Development.IDE.Core.PluginUtils as PluginUtils import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits), NextPragmaInfo (NextPragmaInfo), @@ -114,11 +119,6 @@ import Development.IDE.Spans.Pragmas (LineSplitTe lineSplitTextEdits, nextPragmaLine) import GHC.Generics (Generic) -#if !MIN_VERSION_apply_refact(0,12,0) -import System.Environment (setEnv, - unsetEnv) -#endif -import Development.IDE.Core.PluginUtils as PluginUtils import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -126,7 +126,9 @@ import Text.Regex.TDFA.Text () data Log = LogShake Shake.Log | LogApplying NormalizedFilePath (Either String WorkspaceEdit) +#if APPLY_REFACT | LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]] +#endif | LogGetIdeas NormalizedFilePath | LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them | forall a. (Pretty a) => LogResolve a @@ -135,7 +137,9 @@ instance Pretty Log where pretty = \case LogShake log -> pretty log LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res +#if APPLY_REFACT LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas +#endif LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <> line <> indent 4 (pretty exts) LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp LogResolve msg -> pretty msg @@ -413,12 +417,19 @@ resolveProvider recorder ideState _plId ca uri resolveValue = do edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle pure $ ca & LSP.edit ?~ edit +applyRefactAvailable :: Bool +#if APPLY_REFACT +applyRefactAvailable = True +#else +applyRefactAvailable = False +#endif + -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable diagnosticToCodeActions :: VersionedTextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction] diagnosticToCodeActions verTxtDocId diagnostic | LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic - , let isHintApplicable = "refact:" `T.isPrefixOf` code + , let isHintApplicable = "refact:" `T.isPrefixOf` code && applyRefactAvailable , let hint = T.replace "refact:" "" code , let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module" , let suppressHintArguments = IgnoreHint verTxtDocId hint @@ -453,19 +464,10 @@ mkSuppressHintTextEdits dynFlags fileContents hint = NextPragmaInfo{ nextPragmaLine, lineSplitTextEdits } = getNextPragmaInfo dynFlags (Just fileContents) nextPragmaLinePosition = Position (fromIntegral nextPragmaLine) 0 nextPragmaRange = Range nextPragmaLinePosition nextPragmaLinePosition - wnoUnrecognisedPragmasText = - if wopt Opt_WarnUnrecognisedPragmas dynFlags - then Just "{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}\n" - else Nothing - hlintIgnoreText = Just ("{-# HLINT ignore \"" <> hint <> "\" #-}\n") - -- we combine the texts into a single text because lsp-test currently - -- applies text edits backwards and I want the options pragma to - -- appear above the hlint pragma in the tests - combinedText = mconcat $ catMaybes [wnoUnrecognisedPragmasText, hlintIgnoreText] - combinedTextEdit = LSP.TextEdit nextPragmaRange combinedText + textEdit = LSP.TextEdit nextPragmaRange $ "{- HLINT ignore \"" <> hint <> "\" -}\n" lineSplitTextEditList = maybe [] (\LineSplitTextEdits{..} -> [lineSplitInsertTextEdit, lineSplitDeleteTextEdit]) lineSplitTextEdits in - combinedTextEdit : lineSplitTextEditList + textEdit : lineSplitTextEditList -- --------------------------------------------------------------------- ignoreHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> VersionedTextDocumentIdentifier -> HintTitle -> IO (Either PluginError WorkspaceEdit) @@ -506,6 +508,11 @@ data OneHint = } deriving (Generic, Eq, Show, ToJSON, FromJSON) applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit) +#if !APPLY_REFACT +applyHint _ _ _ _ _ = + -- https://github.com/ndmitchell/hlint/pull/1594#issuecomment-2338898673 + evaluate $ error "Cannot apply refactoring: apply-refact does not work on GHC 9.10" +#else applyHint recorder ide nfp mhint verTxtDocId = runExceptT $ do let runAction' :: Action a -> IO a @@ -607,7 +614,7 @@ applyRefactorings :: -- with the @LANGUAGE@ pragmas, pragmas win. [String] -> IO String -applyRefactorings = +applyRefactorings = #if MIN_VERSION_apply_refact(0,12,0) Refact.applyRefactorings #else @@ -624,3 +631,4 @@ applyRefactorings = withRuntimeLibdir libdir = bracket_ (setEnv key libdir) (unsetEnv key) where key = "GHC_EXACTPRINT_GHC_LIBDIR" #endif +#endif diff --git a/plugins/hls-hlint-plugin/test/Main.hs b/plugins/hls-hlint-plugin/test/Main.hs index 7d92706051..360a9c0c01 100644 --- a/plugins/hls-hlint-plugin/test/Main.hs +++ b/plugins/hls-hlint-plugin/test/Main.hs @@ -45,12 +45,12 @@ getApplyHintText :: T.Text -> T.Text getApplyHintText name = "Apply hint \"" <> name <> "\"" resolveTests :: TestTree -resolveTests = testGroup "hlint resolve tests" +resolveTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint resolve tests" [ ignoreHintGoldenResolveTest - "Resolve version of: Ignore hint in this module inserts -Wno-unrecognised-pragmas and hlint ignore pragma if warn unrecognized pragmas is off" - "UnrecognizedPragmasOff" - (Point 3 8) + "Resolve version of: Ignore hint in this module inserts hlint ignore pragma" + "IgnoreHintAction" + (Point 2 8) "Eta reduce" , applyHintGoldenResolveTest "Resolve version of: [#2612] Apply hint works when operator fixities go right-to-left" @@ -64,19 +64,14 @@ ignoreHintTests :: TestTree ignoreHintTests = testGroup "hlint ignore hint tests" [ ignoreHintGoldenTest - "Ignore hint in this module inserts -Wno-unrecognised-pragmas and hlint ignore pragma if warn unrecognized pragmas is off" - "UnrecognizedPragmasOff" - (Point 3 8) - "Eta reduce" - , ignoreHintGoldenTest - "Ignore hint in this module inserts only hlint ignore pragma if warn unrecognized pragmas is on" - "UnrecognizedPragmasOn" - (Point 3 9) + "Ignore hint in this module inserts hlint ignore pragma" + "IgnoreHintAction" + (Point 2 8) "Eta reduce" ] applyHintTests :: TestTree -applyHintTests = testGroup "hlint apply hint tests" +applyHintTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint apply hint tests" [ applyHintGoldenTest "[#2612] Apply hint works when operator fixities go right-to-left" @@ -88,7 +83,7 @@ applyHintTests = testGroup "hlint apply hint tests" suggestionsTests :: TestTree suggestionsTests = testGroup "hlint suggestions" [ - testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do + knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do doc <- openDoc "Base.hs" "haskell" diags@(reduceDiag:_) <- hlintCaptureKick @@ -120,7 +115,7 @@ suggestionsTests = contents <- skipManyTill anyMessage $ getDocumentEdit doc liftIO $ contents @?= "main = undefined\nfoo x = x\n" - , testCase "falls back to pre 3.8 code actions" $ + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "falls back to pre 3.8 code actions" $ runSessionWithTestConfig def { testConfigCaps = noLiteralCaps , testDirLocation = Left testDir @@ -179,15 +174,15 @@ suggestionsTests = doc <- openDoc "CppHeader.hs" "haskell" testHlintDiagnostics doc - , testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do testRefactor "LambdaCase.hs" "Redundant bracket" expectedLambdaCase - , testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do testRefactor "TypeApplication.hs" "Redundant bracket" expectedTypeApp - , testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do testRefactor "LambdaCase.hs" "Redundant bracket" ("{-# LANGUAGE LambdaCase #-}" : expectedLambdaCase) @@ -213,10 +208,10 @@ suggestionsTests = doc <- openDoc "IgnoreAnnHlint.hs" "haskell" testNoHlintDiagnostics doc - , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do testRefactor "Comments.hs" "Redundant bracket" expectedComments - , testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do testRefactor "TwoHintsAndComment.hs" "Apply all hints" expectedComments2 , testCase "applyAll is shown only when there is at least one diagnostic in range" $ runHlintSession "" $ do diff --git a/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.expected.hs b/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.expected.hs new file mode 100644 index 0000000000..b3ae28995e --- /dev/null +++ b/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.expected.hs @@ -0,0 +1,3 @@ +{- HLINT ignore "Eta reduce" -} +module IgnoreHintAction where +foo x = id x diff --git a/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.hs b/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.hs new file mode 100644 index 0000000000..7fb147a40f --- /dev/null +++ b/plugins/hls-hlint-plugin/test/testdata/IgnoreHintAction.hs @@ -0,0 +1,2 @@ +module IgnoreHintAction where +foo x = id x diff --git a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.expected.hs b/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.expected.hs deleted file mode 100644 index 31d9aed946..0000000000 --- a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Eta reduce" #-} -module UnrecognizedPragmasOff where -foo x = id x diff --git a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.hs b/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.hs deleted file mode 100644 index 2611c9a7f7..0000000000 --- a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOff.hs +++ /dev/null @@ -1,3 +0,0 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -module UnrecognizedPragmasOff where -foo x = id x diff --git a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.expected.hs b/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.expected.hs deleted file mode 100644 index 564503ca40..0000000000 --- a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# OPTIONS_GHC -Wunrecognised-pragmas #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Eta reduce" #-} -module UnrecognizedPragmasOn where -foo x = id x diff --git a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.hs b/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.hs deleted file mode 100644 index bac66497ba..0000000000 --- a/plugins/hls-hlint-plugin/test/testdata/UnrecognizedPragmasOn.hs +++ /dev/null @@ -1,3 +0,0 @@ -{-# OPTIONS_GHC -Wunrecognised-pragmas #-} -module UnrecognizedPragmasOn where -foo x = id x diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 1c40ea76b3..db1696d94b 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -1,17 +1,21 @@ module Ide.Plugin.Notes (descriptor, Log) where import Control.Lens ((^.)) -import Control.Monad.Except (throwError) +import Control.Monad.Except (ExceptT, MonadError, + throwError) import Control.Monad.IO.Class (liftIO) import qualified Data.Array as A +import Data.Foldable (foldl') import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS +import Data.List (uncons) import Data.Maybe (catMaybes, listToMaybe, mapMaybe) import Data.Text (Text, intercalate) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope +import Data.Traversable (for) import Development.IDE hiding (line) import Development.IDE.Core.PluginUtils (runActionE, useE) import Development.IDE.Core.Shake (toKnownFiles) @@ -21,8 +25,8 @@ import GHC.Generics (Generic) import Ide.Plugin.Error (PluginError (..)) import Ide.Types import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition), - SMethod (SMethod_TextDocumentDefinition)) +import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition, Method_TextDocumentReferences), + SMethod (SMethod_TextDocumentDefinition, SMethod_TextDocumentReferences)) import Language.LSP.Protocol.Types import Text.Regex.TDFA (Regex, caseSensitive, defaultCompOpt, @@ -31,25 +35,39 @@ import Text.Regex.TDFA (Regex, caseSensitive, data Log = LogShake Shake.Log - | LogNotesFound NormalizedFilePath [(Text, Position)] + | LogNotesFound NormalizedFilePath [(Text, [Position])] + | LogNoteReferencesFound NormalizedFilePath [(Text, [Position])] deriving Show data GetNotesInFile = MkGetNotesInFile deriving (Show, Generic, Eq, Ord) deriving anyclass (Hashable, NFData) -type instance RuleResult GetNotesInFile = HM.HashMap Text Position +-- The GetNotesInFile action scans the source file and extracts a map of note +-- definitions (note name -> position) and a map of note references +-- (note name -> [position]). +type instance RuleResult GetNotesInFile = (HM.HashMap Text Position, HM.HashMap Text [Position]) data GetNotes = MkGetNotes deriving (Show, Generic, Eq, Ord) deriving anyclass (Hashable, NFData) +-- GetNotes collects all note definition across all files in the +-- project. It returns a map from note name to pair of (filepath, position). type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position) +data GetNoteReferences = MkGetNoteReferences + deriving (Show, Generic, Eq, Ord) + deriving anyclass (Hashable, NFData) +-- GetNoteReferences collects all note references across all files in the +-- project. It returns a map from note name to list of (filepath, position). +type instance RuleResult GetNoteReferences = HashMap Text [(NormalizedFilePath, Position)] + instance Pretty Log where pretty = \case - LogShake l -> pretty l - LogNotesFound file notes -> - "Found notes in " <> pretty (show file) <> ": [" - <> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> T.pack (show p)) notes)) <> "]" + LogShake l -> pretty l + LogNoteReferencesFound file refs -> "Found note references in " <> prettyNotes file refs + LogNotesFound file notes -> "Found notes in " <> prettyNotes file notes + where prettyNotes file hm = pretty (show file) <> ": [" + <> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> intercalate ", " (map (T.pack . show) p)) hm)) <> "]" {- The first time the user requests a jump-to-definition on a note reference, the @@ -59,7 +77,9 @@ title is then saved in the HLS database to be retrieved for all future requests. descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId "Provides goto definition support for GHC-style notes") { Ide.Types.pluginRules = findNotesRules recorder - , Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDefinition jumpToNote + , Ide.Types.pluginHandlers = + mkPluginHandler SMethod_TextDocumentDefinition jumpToNote + <> mkPluginHandler SMethod_TextDocumentReferences listReferences } findNotesRules :: Recorder (WithPriority Log) -> Rules () @@ -69,20 +89,59 @@ findNotesRules recorder = do defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNotes _ -> do targets <- toKnownFiles <$> useNoFile_ GetKnownTargets - definedNotes <- catMaybes <$> mapM (\nfp -> fmap (HM.map (nfp,)) <$> use MkGetNotesInFile nfp) (HS.toList targets) + definedNotes <- catMaybes <$> mapM (\nfp -> fmap (HM.map (nfp,) . fst) <$> use MkGetNotesInFile nfp) (HS.toList targets) pure $ Just $ HM.unions definedNotes + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNoteReferences _ -> do + targets <- toKnownFiles <$> useNoFile_ GetKnownTargets + definedReferences <- catMaybes <$> for (HS.toList targets) (\nfp -> do + references <- fmap snd <$> use MkGetNotesInFile nfp + pure $ fmap (HM.map (fmap (nfp,))) references + ) + pure $ Just $ foldl' (HM.unionWith (<>)) HM.empty definedReferences + +err :: MonadError PluginError m => Text -> Maybe a -> m a +err s = maybe (throwError $ PluginInternalError s) pure + +getNote :: NormalizedFilePath -> IdeState -> Position -> ExceptT PluginError (HandlerM c) (Maybe Text) +getNote nfp state (Position l c) = do + contents <- + err "Error getting file contents" + =<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp)) + line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst + (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) + pure $ listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line + where + atPos c arr = case arr A.! 0 of + -- We check if the line we are currently at contains a note + -- reference. However, we need to know if the cursor is within the + -- match or somewhere else. The second entry of the array contains + -- the title of the note as extracted by the regex. + (_, (c', len)) -> if c' <= c && c <= c' + len + then Just (fst (arr A.! 1)) else Nothing + +listReferences :: PluginMethodHandler IdeState Method_TextDocumentReferences +listReferences state _ param + | Just nfp <- uriToNormalizedFilePath uriOrig + = do + let pos@(Position l _) = param ^. L.position + noteOpt <- getNote nfp state pos + case noteOpt of + Nothing -> pure (InR Null) + Just note -> do + notes <- runActionE "notes.definedNoteReferencess" state $ useE MkGetNoteReferences nfp + poss <- err ("Note reference (a comment of the form `{- Note [" <> note <> "] -}`) not found") (HM.lookup note notes) + pure $ InL (mapMaybe (\(noteFp, pos@(Position l' _)) -> if l' == l then Nothing else Just ( + Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos))) poss) + where + uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) +listReferences _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" + jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition jumpToNote state _ param | Just nfp <- uriToNormalizedFilePath uriOrig = do - let Position l c = param ^. L.position - contents <- - err "Error getting file contents" - =<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp)) - line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst - (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) - let noteOpt = listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line + noteOpt <- getNote nfp state (param ^. L.position) case noteOpt of Nothing -> pure (InR (InR Null)) Just note -> do @@ -93,17 +152,9 @@ jumpToNote state _ param )) where uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) - err s = maybe (throwError $ PluginInternalError s) pure - atPos c arr = case arr A.! 0 of - -- We check if the line we are currently at contains a note - -- reference. However, we need to know if the cursor is within the - -- match or somewhere else. The second entry of the array contains - -- the title of the note as extracted by the regex. - (_, (c', len)) -> if c' <= c && c <= c' + len - then Just (fst (arr A.! 1)) else Nothing jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" -findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position)) +findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position, HM.HashMap Text [Position])) findNotesInFile file recorder = do -- GetFileContents only returns a value if the file is open in the editor of -- the user. If not, we need to read it from disk. @@ -111,10 +162,13 @@ findNotesInFile file recorder = do content <- case contentOpt of Just x -> pure $ Rope.toText x Nothing -> liftIO $ readFileUtf8 $ fromNormalizedFilePath file - let matches = (A.! 1) <$> matchAllText noteRegex content - m = toPositions matches content - logWith recorder Debug $ LogNotesFound file (HM.toList m) - pure $ Just m + let noteMatches = (A.! 1) <$> matchAllText noteRegex content + notes = toPositions noteMatches content + logWith recorder Debug $ LogNotesFound file (HM.toList notes) + let refMatches = (A.! 1) <$> matchAllText noteRefRegex content + refs = toPositions refMatches content + logWith recorder Debug $ LogNoteReferencesFound file (HM.toList refs) + pure $ Just (HM.mapMaybe (fmap fst . uncons) notes, refs) where uint = fromIntegral . toInteger -- the regex library returns the character index of the match. However @@ -129,7 +183,7 @@ findNotesInFile file recorder = do let !c' = c + 1 (!n', !nc') = if char' == '\n' then (n + 1, c') else (n, nc) p@(!_, !_) = if char == c then - (xs, HM.insert name (Position (uint n') (uint (char - nc'))) m) + (xs, HM.insertWith (<>) name [Position (uint n') (uint (char - nc'))] m) else (x:xs, m) in (p, (n', nc', c')) ) ((matches, HM.empty), (0, 0, 0)) diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index f87cf98a98..f84bed9731 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -11,6 +11,7 @@ main :: IO () main = defaultTestRunner $ testGroup "Notes" [ gotoNoteTests + , noteReferenceTests ] runSessionWithServer' :: FilePath -> (FilePath -> Session a) -> IO a @@ -21,6 +22,21 @@ runSessionWithServer' fp act = , testDirLocation = Left fp } act +noteReferenceTests :: TestTree +noteReferenceTests = testGroup "Note References" + [ + testCase "multi_file" $ runSessionWithServer' testDataDir $ \dir -> do + doc <- openDoc "NoteDef.hs" "haskell" + waitForKickDone + refs <- getReferences doc (Position 21 15) False + let fp = dir "NoteDef.hs" + liftIO $ refs @?= [ + Location (filePathToUri (dir "Other.hs")) (Range (Position 6 13) (Position 6 13)), + Location (filePathToUri fp) (Range (Position 9 9) (Position 9 9)), + Location (filePathToUri fp) (Range (Position 5 67) (Position 5 67)) + ] + ] + gotoNoteTests :: TestTree gotoNoteTests = testGroup "Goto Note Definition" [ @@ -29,13 +45,13 @@ gotoNoteTests = testGroup "Goto Note Definition" waitForKickDone defs <- getDefinitions doc (Position 3 41) let fp = dir "NoteDef.hs" - liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 8 9) (Position 8 9))])) + liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 11 9) (Position 11 9))])) , testCase "liberal_format" $ runSessionWithServer' testDataDir $ \dir -> do doc <- openDoc "NoteDef.hs" "haskell" waitForKickDone defs <- getDefinitions doc (Position 5 64) let fp = dir "NoteDef.hs" - liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 18 11) (Position 18 11))])) + liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 21 11) (Position 21 11))])) , testCase "invalid_note" $ runSessionWithServer' testDataDir $ const $ do doc <- openDoc "NoteDef.hs" "haskell" @@ -54,7 +70,7 @@ gotoNoteTests = testGroup "Goto Note Definition" waitForKickDone defs <- getDefinitions doc (Position 5 20) let fp = dir "NoteDef.hs" - liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 12 6) (Position 12 6))])) + liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 15 6) (Position 15 6))])) ] testDataDir :: FilePath diff --git a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs index 56b1f6e72a..c4b450ced4 100644 --- a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs +++ b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs @@ -6,6 +6,9 @@ foo _ = 0 -- We always return zero, see Note [Returning zero from foo] -- The plugin is more liberal with the note definitions, see Note [Single line comments] -- It does not work on wrong note definitions, see Note [Not a valid Note] +-- We can also have multiple references to the same note, see +-- Note [Single line comments] + {- Note [Returning zero from foo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This is a big long form note, with very important info diff --git a/plugins/hls-notes-plugin/test/testdata/Other.hs b/plugins/hls-notes-plugin/test/testdata/Other.hs index 65f9a483aa..aa64e19a79 100644 --- a/plugins/hls-notes-plugin/test/testdata/Other.hs +++ b/plugins/hls-notes-plugin/test/testdata/Other.hs @@ -4,3 +4,4 @@ import NoteDef bar :: Int bar = 4 -- See @Note [Multiple notes in comment]@ in NoteDef +-- See Note [Single line comments] diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 011910b880..6917d0a7a9 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -32,17 +32,14 @@ import Development.IDE.Core.RuleTypes (GetFileContents (GetFileConte TcModuleResult (TcModuleResult, tmrParsed, tmrTypechecked), TypeCheck (TypeCheck)) import Development.IDE.Core.Shake (IdeState) -import Development.IDE.GHC.Compat (ContextInfo (Use), - GenLocated (..), GhcPs, +import Development.IDE.GHC.Compat (GenLocated (..), GhcPs, GlobalRdrElt, GlobalRdrEnv, HsModule (hsmodImports), - Identifier, - IdentifierDetails (IdentifierDetails, identInfo), ImpDeclSpec (ImpDeclSpec, is_as, is_dloc, is_qual), ImportSpec (ImpSpec), LImportDecl, ModuleName, Name, NameEnv, ParsedModule, - RefMap, Span, SrcSpan, + SrcSpan, TcGblEnv (tcg_rdr_env), emptyUFM, globalRdrEnvElts, gre_imp, gre_name, locA, @@ -58,6 +55,9 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), srcSpanStartLine, unitUFM) import Development.IDE.Types.Location (Position (Position), Range (Range), Uri) +import GHC.Iface.Ext.Types (ContextInfo (..), Identifier, + IdentifierDetails (..), Span) +import GHC.Iface.Ext.Utils (RefMap) import Ide.Plugin.Error (PluginError (PluginRuleFailed), getNormalizedFilePathE, handleMaybe) 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 c610225ef5..638d14c51d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -127,6 +127,7 @@ showAstDataHtml a0 = html $ sourceText :: SourceText -> SDoc sourceText NoSourceText = text "NoSourceText" + #if MIN_VERSION_ghc(9,7,0) sourceText (SourceText src) = text "SourceText" <+> ftext src #else @@ -134,13 +135,13 @@ showAstDataHtml a0 = html $ #endif epaAnchor :: EpaLocation -> SDoc + #if MIN_VERSION_ghc(9,9,0) epaAnchor (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s -#elif MIN_VERSION_ghc(9,5,0) - epaAnchor (EpaSpan r _) = text "EpaSpan" <+> realSrcSpan r #else - epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r + epaAnchor (EpaSpan r _) = text "EpaSpan" <+> realSrcSpan r #endif + #if MIN_VERSION_ghc(9,11,0) epaAnchor (EpaDelta s d cs) = text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> showAstDataHtml' cs #else @@ -239,13 +240,8 @@ showAstDataHtml a0 = html $ annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase") -#if MIN_VERSION_ghc(9,4,0) annotationEpAnnHsLet :: EpAnn NoEpAnns -> SDoc annotationEpAnnHsLet = annotation' (text "EpAnn NoEpAnns") -#else - annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc - annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet") -#endif #if MIN_VERSION_ghc(9,11,0) annotationAnnList :: EpAnn (AnnList ()) -> SDoc diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 0f740688be..666de9a6f2 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -151,13 +151,8 @@ instance Hashable GetAnnotatedParsedSource instance NFData GetAnnotatedParsedSource type instance RuleResult GetAnnotatedParsedSource = ParsedSource -#if MIN_VERSION_ghc(9,5,0) instance Show (HsModule GhcPs) where show _ = "" -#else -instance Show HsModule where - show _ = "" -#endif -- | Get the latest version of the annotated parse source with comments. getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules () @@ -622,17 +617,10 @@ modifyMgMatchesT' :: r -> (r -> r -> m r) -> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r) -#if MIN_VERSION_ghc(9,5,0) modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do (unzip -> (matches', rs)) <- mapM f matches r' <- TransformT $ lift $ foldM combineResults def rs pure (MG xMg (L locMatches matches'), r') -#else -modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do - (unzip -> (matches', rs)) <- mapM f matches - r' <- lift $ foldM combineResults def rs - pure (MG xMg (L locMatches matches') originMg, r') -#endif graftSmallestDeclsWithM :: forall a. @@ -735,26 +723,16 @@ annotate :: ASTElement l ast annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast -#if MIN_VERSION_ghc(9,4,0) expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) -#else - expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered - pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) -#endif -- | Given an 'LHsDecl', compute its exactprint annotations. annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs) annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast -#if MIN_VERSION_ghc(9,4,0) expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0 -#else - expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered - pure $ setPrecedingLines expr' 1 0 -#endif ------------------------------------------------------------------------------ diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 0f41f988e8..1fba6b67e5 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -18,7 +18,6 @@ module Development.IDE.Plugin.CodeAction ) where import Control.Applicative ((<|>)) -import Control.Applicative.Combinators.NonEmpty (sepBy1) import Control.Arrow (second, (&&&), (>>>)) @@ -73,15 +72,15 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options -import GHC ( - DeltaPos (..), +import GHC (DeltaPos (..), EpAnn (..), LEpaComment) +import GHC.Iface.Ext.Types (ContextInfo (..), + IdentifierDetails (..)) import qualified GHC.LanguageExtensions as Lang import Ide.Logger hiding (group) import Ide.PluginUtils (extendToFullLines, - extractTextInRange, subRange) import Ide.Types import Language.LSP.Protocol.Message (Method (..), @@ -101,7 +100,6 @@ import Language.LSP.Protocol.Types (ApplyWorkspa type (|?) (InL, InR), uriToFilePath) import qualified Text.Fuzzy.Parallel as TFP -import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -109,9 +107,9 @@ import Text.Regex.TDFA ((=~), (=~~)) #if !MIN_VERSION_ghc(9,9,0) import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst) import GHC (AddEpAnn (AddEpAnn), - AnnsModule (am_main), Anchor (anchor_op), AnchorOperation (..), + AnnsModule (am_main), EpaLocation (..)) #endif @@ -121,15 +119,14 @@ import GHC (AddEpAnn (Ad EpaLocation, EpaLocation' (..), HasLoc (..)) -import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) #endif + #if MIN_VERSION_ghc(9,11,0) -import GHC (EpaLocation, - AnnsModule (am_where), +import GHC (AnnsModule (am_where), + EpToken (..), + EpaLocation, EpaLocation' (..), - HasLoc (..), - EpToken (..)) -import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) + HasLoc (..)) #endif @@ -272,19 +269,11 @@ extendImportHandler' ideState ExtendImport {..} isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool isWantedModule wantedModule Nothing (L _ it@ImportDecl{ ideclName -#if MIN_VERSION_ghc(9,5,0) , ideclImportList = Just (Exactly, _) -#else - , ideclHiding = Just (False, _) -#endif }) = not (isQualifiedImport it) && unLoc ideclName == wantedModule isWantedModule wantedModule (Just qual) (L _ ImportDecl{ ideclAs, ideclName -#if MIN_VERSION_ghc(9,5,0) , ideclImportList = Just (Exactly, _) -#else - , ideclHiding = Just (False, _) -#endif }) = unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False @@ -682,14 +671,16 @@ suggestDeleteUnusedBinding indexedContent name (L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do - let go bag lsigs = + let emptyBag bag = #if MIN_VERSION_ghc(9,11,0) - if null bag + null bag #else - if isEmptyBag bag + isEmptyBag bag #endif - then [] - else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag + go bag lsigs = + if emptyBag bag + then [] + else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag case grhssLocalBinds of (HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs _ -> [] @@ -860,7 +851,6 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, | otherwise = [] where makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")" -#if MIN_VERSION_ghc(9,4,0) pat multiple at inArg inExpr = T.concat [ ".*Defaulting the type variable " , ".*to type ‘([^ ]+)’ " , "in the following constraint" @@ -871,17 +861,6 @@ suggestAddTypeAnnotationToSatisfyConstraints sourceOpt Diagnostic{_range=_range, , if inExpr then ".+In the expression" else "" , ".+In the expression" ] -#else - pat multiple at inArg inExpr = T.concat [ ".*Defaulting the following constraint" - , if multiple then "s" else "" - , " to type ‘([^ ]+)’ " - , ".*arising from the literal ‘(.+)’" - , if inArg then ".+In the.+argument" else "" - , if at then ".+at ([^ ]*)" else "" - , if inExpr then ".+In the expression" else "" - , ".+In the expression" - ] -#endif codeEdit range ty lit replacement = let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’" edits = [TextEdit range replacement] @@ -1161,17 +1140,10 @@ occursUnqualified symbol ImportDecl{..} | isNothing ideclAs = Just False /= -- I don't find this particularly comprehensible, -- but HLint suggested me to do so... -#if MIN_VERSION_ghc(9,5,0) (ideclImportList <&> \(isHiding, L _ ents) -> let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents in (isHiding == EverythingBut) && not occurs || (isHiding == Exactly) && occurs ) -#else - (ideclHiding <&> \(isHiding, L _ ents) -> - let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents - in isHiding && not occurs || not isHiding && occurs - ) -#endif occursUnqualified _ _ = False symbolOccursIn :: T.Text -> IE GhcPs -> Bool @@ -1509,11 +1481,6 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} >>= (findImportDeclByModuleName hsmodImports . T.unpack) >>= ideclAs . unLoc <&> T.pack . moduleNameString . unLoc - , -- tentative workaround for detecting qualification in GHC 9.4 - -- FIXME: We can delete this after dropping the support for GHC 9.4 - qualGHC94 <- - guard (ghcVersion == GHC94) - *> extractQualifiedModuleNameFromMissingName (extractTextInRange _range fileContents) , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg #if MIN_VERSION_ghc(9,7,0) @@ -1522,84 +1489,13 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" #endif = let qis = qualifiedImportStyle df - -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped. - -- In what fllows, @missing@ is assumed to be qualified name. - -- @thingMissing@ is already as desired with GHC != 9.4. - -- In GHC 9.4, however, GHC drops a module qualifier from a qualified symbol. - -- Thus we need to explicitly concatenate qualifier explicity in GHC 9.4. - missing - | GHC94 <- ghcVersion - , isNothing (qual <|> qual') - , Just q <- qualGHC94 = - qualify q thingMissing - | otherwise = thingMissing suggestions = nubSortBy simpleCompareImportSuggestion - (constructNewImportSuggestions packageExportsMap (qual <|> qual' <|> qualGHC94, missing) extendImportSuggestions qis) in + (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where - qualify q (NotInScopeDataConstructor d) = NotInScopeDataConstructor (q <> "." <> d) - qualify q (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (q <> "." <> d) - qualify q (NotInScopeThing d) = NotInScopeThing (q <> "." <> d) - L _ HsModule {..} = ps suggestNewImport _ _ _ _ _ = [] -{- | -Extracts qualifier of the symbol from the missing symbol. -Input must be either a plain qualified variable or possibly-parenthesized qualified binary operator (though no strict checking is done for symbol part). -This is only needed to alleviate the issue #3473. - -FIXME: We can delete this after dropping the support for GHC 9.4 - ->>> extractQualifiedModuleNameFromMissingName "P.lookup" -Just "P" - ->>> extractQualifiedModuleNameFromMissingName "ΣP3_'.σlookup" -Just "\931P3_'" - ->>> extractQualifiedModuleNameFromMissingName "ModuleA.Gre_ekσ.goodδ" -Just "ModuleA.Gre_ek\963" - ->>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ.+)" -Just "ModuleA.Gre_ek\963" - ->>> extractQualifiedModuleNameFromMissingName "(ModuleA.Gre_ekσ..|.)" -Just "ModuleA.Gre_ek\963" - ->>> extractQualifiedModuleNameFromMissingName "A.B.|." -Just "A.B" --} -extractQualifiedModuleNameFromMissingName :: T.Text -> Maybe T.Text -extractQualifiedModuleNameFromMissingName (T.strip -> missing) - = T.pack <$> (T.unpack missing RE.=~ qualIdentP) - where - {- - NOTE: Haskell 2010 allows /unicode/ upper & lower letters - as a module name component; otoh, regex-tdfa only allows - /ASCII/ letters to be matched with @[[:upper:]]@ and/or @[[:lower:]]@. - Hence we use regex-applicative(-text) for finer-grained predicates. - - RULES (from [Section 10 of Haskell 2010 Report](https://www.haskell.org/onlinereport/haskell2010/haskellch10.html)): - modid → {conid .} conid - conid → large {small | large | digit | ' } - small → ascSmall | uniSmall | _ - ascSmall → a | b | … | z - uniSmall → any Unicode lowercase letter - large → ascLarge | uniLarge - ascLarge → A | B | … | Z - uniLarge → any uppercase or titlecase Unicode letter - -} - - qualIdentP = parensQualOpP <|> qualVarP - parensQualOpP = RE.sym '(' *> modNameP <* RE.sym '.' <* RE.anySym <* RE.few RE.anySym <* RE.sym ')' - qualVarP = modNameP <* RE.sym '.' <* RE.some RE.anySym - conIDP = RE.withMatched $ - RE.psym isUpper - *> RE.many - (RE.psym $ \c -> c == '\'' || c == '_' || isUpper c || isLower c || isDigit c) - modNameP = fmap snd $ RE.withMatched $ conIDP `sepBy1` RE.sym '.' - - -- | A Backward compatible implementation of `lookupOccEnv_AllNameSpaces` for -- GHC <=9.6 -- @@ -1742,11 +1638,7 @@ findPositionAfterModuleName ps _hsmodName' = do -- The relative position of 'where' keyword (in lines, relative to the previous AST node). -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. whereKeywordLineOffset :: Maybe Int -#if MIN_VERSION_ghc(9,5,0) whereKeywordLineOffset = case hsmodAnn hsmodExt of -#else - whereKeywordLineOffset = case hsmodAnn of -#endif EpAnn _ annsModule _ -> do -- Find the first 'where' #if MIN_VERSION_ghc(9,11,0) @@ -1759,8 +1651,8 @@ findPositionAfterModuleName ps _hsmodName' = do EpAnnNotUsed -> Nothing #endif #if MIN_VERSION_ghc(9,11,0) - filterWhere (EpTok loc) = Just loc - filterWhere _ = Nothing + filterWhere (EpTok loc) = Just loc + filterWhere _ = Nothing #else filterWhere (AddEpAnn AnnWhere loc) = Just loc filterWhere _ = Nothing @@ -1770,11 +1662,8 @@ findPositionAfterModuleName ps _hsmodName' = do #if MIN_VERSION_ghc(9,9,0) epaLocationToLine (EpaSpan sp) = fmap (srcLocLine . realSrcSpanEnd) $ srcSpanToRealSrcSpan sp -#elif MIN_VERSION_ghc(9,5,0) - epaLocationToLine (EpaSpan sp _) - = Just . srcLocLine . realSrcSpanEnd $ sp #else - epaLocationToLine (EpaSpan sp) + epaLocationToLine (EpaSpan sp _) = Just . srcLocLine . realSrcSpanEnd $ sp #endif #if MIN_VERSION_ghc(9,11,0) @@ -1799,7 +1688,7 @@ findPositionAfterModuleName ps _hsmodName' = do #if MIN_VERSION_ghc(9,11,0) anchorOpLine :: EpaLocation' a -> Int - anchorOpLine EpaSpan{} = 0 + anchorOpLine EpaSpan{} = 0 anchorOpLine (EpaDelta _ (SameLine _) _) = 0 anchorOpLine (EpaDelta _ (DifferentLine line _) _) = line #elif MIN_VERSION_ghc(9,9,0) @@ -2058,21 +1947,12 @@ textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCo -- | Returns the ranges for a binding in an import declaration rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range] -#if MIN_VERSION_ghc(9,5,0) rangesForBindingImport ImportDecl{ ideclImportList = Just (Exactly, L _ lies) } b = concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies where b' = wrapOperatorInParens b -#else -rangesForBindingImport ImportDecl{ - ideclHiding = Just (False, L _ lies) - } b = - concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies - where - b' = wrapOperatorInParens b -#endif rangesForBindingImport _ _ = [] wrapOperatorInParens :: String -> String diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index 53ee5200c0..a4132dd787 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -22,11 +22,13 @@ import Data.Either (fromRight, import Data.Functor ((<&>)) import Data.IORef.Extra import qualified Data.Map as Map -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, + maybeToList) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE hiding (pluginHandlers) +import Development.IDE.Core.PluginUtils (activeDiagnosticsInRange) import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint @@ -53,38 +55,42 @@ type GhcideCodeAction = ExceptT PluginError (ReaderT CodeActionArgs IO) GhcideCo ------------------------------------------------------------------------------------------------- runGhcideCodeAction :: IdeState -> MessageParams Method_TextDocumentCodeAction -> GhcideCodeAction -> HandlerM Config GhcideCodeActionResult -runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = diags}) codeAction = do - let mbFile = toNormalizedFilePath' <$> uriToFilePath uri - runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key - caaGhcSession <- onceIO $ runRule GhcSession - caaExportsMap <- - onceIO $ - caaGhcSession >>= \case - Just env -> do - pkgExports <- envPackageExports env - localExports <- readTVarIO (exportsMap $ shakeExtras state) - pure $ localExports <> pkgExports - _ -> pure mempty - caaIdeOptions <- onceIO $ runAction "GhcideCodeActions.getIdeOptions" state getIdeOptions - caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments - caaContents <- - onceIO $ - runRule GetFileContents <&> \case - Just (_, mbContents) -> fmap Rope.toText mbContents - Nothing -> Nothing - caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule - caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource - caaTmr <- onceIO $ runRule TypeCheck - caaHar <- onceIO $ runRule GetHieAst - caaBindings <- onceIO $ runRule GetBindings - caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs - results <- liftIO $ - sequence - [ runReaderT (runExceptT codeAction) CodeActionArgs {..} - | caaDiagnostic <- diags - ] - let (_errs, successes) = partitionEithers results - pure $ concat successes +runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range _) codeAction + | Just nfp <- toNormalizedFilePath' <$> uriToFilePath uri = do + let runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure (Just nfp)) >>= MaybeT . use key + caaGhcSession <- onceIO $ runRule GhcSession + caaExportsMap <- + onceIO $ + caaGhcSession >>= \case + Just env -> do + pkgExports <- envPackageExports env + localExports <- readTVarIO (exportsMap $ shakeExtras state) + pure $ localExports <> pkgExports + _ -> pure mempty + caaIdeOptions <- onceIO $ runAction "GhcideCodeActions.getIdeOptions" state getIdeOptions + caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments + caaContents <- + onceIO $ + runRule GetFileContents <&> \case + Just (_, mbContents) -> fmap Rope.toText mbContents + Nothing -> Nothing + caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule + caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource + caaTmr <- onceIO $ runRule TypeCheck + caaHar <- onceIO $ runRule GetHieAst + caaBindings <- onceIO $ runRule GetBindings + caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs + diags <- concat . maybeToList <$> activeDiagnosticsInRange (shakeExtras state) nfp _range + results <- liftIO $ + sequence + [ + runReaderT (runExceptT codeAction) CodeActionArgs {..} + | caaDiagnostic <- diags + ] + let (_errs, successes) = partitionEithers results + pure $ concat successes + | otherwise = pure [] + mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) mkCA title kind isPreferred diags edit = @@ -145,7 +151,7 @@ data CodeActionArgs = CodeActionArgs caaHar :: IO (Maybe HieAstResult), caaBindings :: IO (Maybe Bindings), caaGblSigs :: IO (Maybe GlobalBindingTypeSigsResult), - caaDiagnostic :: Diagnostic + caaDiagnostic :: FileDiagnostic } -- | There's no concurrency in each provider, @@ -223,6 +229,9 @@ instance ToCodeAction r => ToCodeAction (IdeOptions -> r) where toCodeAction = toCodeAction3 caaIdeOptions instance ToCodeAction r => ToCodeAction (Diagnostic -> r) where + toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaDiagnostic = x} -> flip runReaderT caa . runExceptT . toCodeAction $ f (fdLspDiagnostic x) + +instance ToCodeAction r => ToCodeAction (FileDiagnostic -> r) where toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaDiagnostic = x} -> flip runReaderT caa . runExceptT . toCodeAction $ f x instance ToCodeAction r => ToCodeAction (Maybe ParsedModule -> r) where diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 2994fe726d..bffd2a611c 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -63,6 +63,7 @@ import GHC (addAnns, ann) #if MIN_VERSION_ghc(9,9,0) import GHC (NoAnn (..)) +import GHC (EpAnnComments (..)) #endif ------------------------------------------------------------------------------ @@ -139,10 +140,8 @@ removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" go :: LHsType GhcPs -> Rewrite #if MIN_VERSION_ghc(9,9,0) go lHsType@(makeDeltaAst -> L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA lHsType) $ \_ -> do -#elif MIN_VERSION_ghc(9,4,0) - go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do #else - go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do + go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do #endif let ctxt' = filter (not . toRemove) ctxt removeStuff = (toRemove <$> headMaybe ctxt) == Just True @@ -151,11 +150,7 @@ removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" [] -> hst_body' _ -> do let ctxt'' = over _last (first removeComma) ctxt' -#if MIN_VERSION_ghc(9,4,0) L l $ it{ hst_ctxt = L l' ctxt'' -#else - L l $ it{ hst_ctxt = Just $ L l' ctxt'' -#endif , hst_body = hst_body' } go (L _ (HsParTy _ ty)) = go ty @@ -172,15 +167,11 @@ appendConstraint :: Rewrite appendConstraint constraintT = go . traceAst "appendConstraint" where -#if MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do -#else - go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do -#endif constraint <- liftParseAST df constraintT constraint <- pure $ setEntryDP constraint (SameLine 1) #if MIN_VERSION_ghc(9,9,0) - let l'' = fmap (addParensToCtxt close_dp) l' + let l'' = moveCommentsToTheEnd $ fmap (addParensToCtxt close_dp) l' #else let l'' = (fmap.fmap) (addParensToCtxt close_dp) l' #endif @@ -196,11 +187,7 @@ appendConstraint constraintT = go . traceAst "appendConstraint" #endif _ -> Nothing ctxt' = over _last (first addComma) $ map dropHsParTy ctxt -#if MIN_VERSION_ghc(9,4,0) return $ L l $ it{hst_ctxt = L l'' $ ctxt' ++ [constraint]} -#else - return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]} -#endif go (L _ HsForAllTy{hst_body}) = go hst_body go (L _ (HsParTy _ ty)) = go ty go ast@(L l _) = Rewrite (locA l) $ \df -> do @@ -208,11 +195,7 @@ appendConstraint constraintT = go . traceAst "appendConstraint" constraint <- liftParseAST df constraintT lContext <- uniqueSrcSpanT lTop <- uniqueSrcSpanT -#if MIN_VERSION_ghc(9,4,0) let context = reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint] -#else - let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint] -#endif #if MIN_VERSION_ghc(9,11,0) annCtxt = AnnContext (Just (EpUniTok (epl 1) NormalSyntax)) [EpTok (epl 0) | needsParens] [EpTok (epl 0) | needsParens] #else @@ -223,6 +206,26 @@ appendConstraint constraintT = go . traceAst "appendConstraint" return $ reLocA $ L lTop $ HsQualTy noExtField context ast +#if MIN_VERSION_ghc(9,9,0) +-- | This moves comment annotation toward the end of the block +-- This is useful when extending a block, so the comment correctly appears +-- after. +-- +-- See https://github.com/haskell/haskell-language-server/issues/4648 for +-- discussion. +-- +-- For example, the following element, @(Foo) => -- hello@, when introducing an +-- additionnal constraint, `Bar`, instead of getting `@(Foo, Bar) => -- hello@, +-- we get @(Foo, -- hello Bar) =>@ +-- +-- This is a bit painful that the pretty printer is not able to realize that it +-- introduces the token `=>` inside the comment and instead does something with +-- meaning, but that's another story. +moveCommentsToTheEnd :: EpAnn ann -> EpAnn ann +moveCommentsToTheEnd (EpAnn entry anns (EpaComments priors)) = EpAnn entry anns (EpaCommentsBalanced { priorComments = [], followingComments = priors}) +moveCommentsToTheEnd (EpAnn entry anns (EpaCommentsBalanced priors following)) = EpAnn entry anns (EpaCommentsBalanced { priorComments = [], followingComments = priors <> following}) +#endif + liftParseAST :: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast)) => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast) @@ -264,11 +267,7 @@ extendImportTopLevel :: LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportTopLevel thing (L l it@ImportDecl{..}) -#if MIN_VERSION_ghc(9,5,0) | Just (hide, L l' lies) <- ideclImportList -#else - | Just (hide, L l' lies) <- ideclHiding -#endif = do src <- uniqueSrcSpanT top <- uniqueSrcSpanT @@ -280,9 +279,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) TransformT $ lift (Left $ thing <> " already imported") let lie = reLocA $ L src $ IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif rdr x = reLocA $ L top $ IEVar #if MIN_VERSION_ghc(9,8,0) @@ -299,11 +296,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) then TransformT $ lift (Left $ thing <> " already imported") else do let lies' = addCommaInImportList lies x -#if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' lies')} -#else - return $ L l it{ideclHiding = Just (hide, L l' lies')} -#endif extendImportTopLevel _ _ = TransformT $ lift $ Left "Unable to extend the import list" wildCardSymbol :: String @@ -333,11 +326,7 @@ extendImportViaParent :: LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) extendImportViaParent df parent child (L l it@ImportDecl{..}) -#if MIN_VERSION_ghc(9,5,0) | Just (hide, L l' lies) <- ideclImportList = go hide l' [] lies -#else - | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies -#endif where #if MIN_VERSION_ghc(9,9,0) go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie) _)) : _xs) @@ -355,9 +344,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child childLIE = reLocA $ L srcChild $ IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif childRdr x :: LIE GhcPs = L ll' $ IEThingWith #if MIN_VERSION_ghc(9,11,0) @@ -374,12 +361,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) docs #endif - -#if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} -#else - return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} -#endif #if MIN_VERSION_ghc(9,9,0) go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies' docs)) : xs) @@ -389,11 +371,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | parent == unIEWrappedName ie , child == wildCardSymbol = do -#if MIN_VERSION_ghc(9,5,0) let it' = it{ideclImportList = Just (hide, lies)} -#else - let it' = it{ideclHiding = Just (hide, lies)} -#endif thing = IEThingWith newl twIE (IEWildcard 2) [] #if MIN_VERSION_ghc(9,9,0) docs @@ -419,15 +397,9 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) TransformT $ lift (Left $ child <> " already included in " <> parent <> " imports") let childLIE = reLocA $ L srcChild $ IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif childRdr -#if MIN_VERSION_ghc(9,5,0) let it' = it{ideclImportList = Just (hide, lies)} -#else - let it' = it{ideclHiding = Just (hide, lies)} -#endif lies = L l' $ reverse pre ++ [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]) #if MIN_VERSION_ghc(9,9,0) @@ -451,9 +423,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let parentLIE = reLocA $ L srcParent $ if isParentOperator then IEType (epl 0) parentRdr' #endif else IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif parentRdr' parentRdr' = modifyAnns parentRdr $ \case #if MIN_VERSION_ghc(9,11,0) @@ -463,9 +433,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #endif other -> other childLIE = reLocA $ L srcChild $ IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif childRdr #if MIN_VERSION_ghc(9,11,0) listAnn = (Nothing, (EpTok (epl 1), NoEpTok, NoEpTok, EpTok (epl 0))) @@ -482,11 +450,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #endif lies' = addCommaInImportList (reverse pre) x -#if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' lies')} -#else - return $ L l it{ideclHiding = Just (hide, L l' lies')} -#endif extendImportViaParent _ _ _ _ = TransformT $ lift $ Left "Unable to extend the import list via parent" -- Add an item in an import list, taking care of adding comma if needed. @@ -527,11 +491,7 @@ addCommaInImportList lies x = fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a] fixLast = over _last (first (if existingTrailingComma then id else addComma)) -#if MIN_VERSION_ghc(9,5,0) unIEWrappedName :: IEWrappedName GhcPs -> String -#else -unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String -#endif unIEWrappedName (occName -> occ) = T.unpack $ printOutputable $ parenSymOcc occ (ppr occ) hasParen :: String -> Bool @@ -545,17 +505,10 @@ hasParen _ = False hideSymbol :: String -> LImportDecl GhcPs -> Rewrite hideSymbol symbol lidecl@(L loc ImportDecl{..}) = -#if MIN_VERSION_ghc(9,5,0) case ideclImportList of Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing Just (EverythingBut, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) Just (Exactly, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl $ setEntryDP (makeDeltaAst imports) (SameLine 1) -#else - case ideclHiding of - Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing - Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) - Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports -#endif extendHiding :: String -> @@ -568,7 +521,7 @@ extendHiding symbol (L l idecls) mlies df = do Nothing -> do #if MIN_VERSION_ghc(9,11,0) let ann :: EpAnn (AnnList (EpToken "hiding", [EpToken ","])) - ann = noAnnSrcSpanDP0 + ann = noAnnSrcSpanDP0 #elif MIN_VERSION_ghc(9,9,0) let ann = noAnnSrcSpanDP0 #else @@ -597,9 +550,7 @@ extendHiding symbol (L l idecls) mlies df = do rdr <- liftParseAST df symbol rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr) let lie = reLocA $ L src $ IEName -#if MIN_VERSION_ghc(9,5,0) noExtField -#endif rdr x = reLocA $ L top $ IEVar #if MIN_VERSION_ghc(9,7,0) @@ -613,11 +564,7 @@ extendHiding symbol (L l idecls) mlies df = do #endif x <- pure $ if hasSibling then first addComma x else x lies <- pure $ over _head (`setEntryDP` SameLine 1) lies -#if MIN_VERSION_ghc(9,5,0) return $ L l idecls{ideclImportList = Just (EverythingBut, L l' $ x : lies)} -#else - return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)} -#endif where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc @@ -632,11 +579,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) (L lieLoc lies) _ = do lidecl' = L l $ idecl -#if MIN_VERSION_ghc(9,5,0) { ideclImportList = Just (Exactly, edited) } -#else - { ideclHiding = Just (False, edited) } -#endif pure lidecl' where deletedLies = diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs index 40f3c76127..2a7719fdbe 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs @@ -10,6 +10,7 @@ import Development.IDE.GHC.Compat.ExactPrint as GHC import Development.IDE.GHC.Dump (showAstDataHtml) import GHC.Stack import GHC.Utils.Outputable +import System.Directory.Extra (createDirectoryIfMissing) import System.Environment.Blank (getEnvDefault) import System.IO.Unsafe import Text.Printf @@ -37,6 +38,7 @@ traceAst lbl x doTrace = unsafePerformIO $ do u <- U.newUnique let htmlDumpFileName = printf "/tmp/hls/%s-%s-%d.html" (show timestamp) lbl (U.hashUnique u) + createDirectoryIfMissing True "/tmp/hls" writeFile htmlDumpFileName $ renderDump htmlDump return $ unlines [prettyCallStack callStack ++ ":" diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index f48d8355d7..aec82cb17f 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -24,13 +24,7 @@ import Language.LSP.Protocol.Types -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,4,0) -import GHC.Parser.Annotation (IsUnicodeSyntax (..), - TrailingAnn (..)) -import Language.Haskell.GHC.ExactPrint (d1) -#endif - -#if MIN_VERSION_ghc(9,4,0) && !MIN_VERSION_ghc(9,9,0) +#if MIN_VERSION_ghc(9,6,0) && !MIN_VERSION_ghc(9,9,0) import Development.IDE.GHC.ExactPrint (epl) import GHC.Parser.Annotation (TokenLocation (..)) #endif @@ -50,8 +44,9 @@ import GHC (DeltaPos (..), IsUnicodeSyntax (NormalSyntax)) import Language.Haskell.GHC.ExactPrint (d1, setEntryDP) #endif + #if MIN_VERSION_ghc(9,11,0) -import GHC.Parser.Annotation (EpToken(..)) +import GHC.Parser.Annotation (EpToken (..)) #endif -- When GHC tells us that a variable is not bound, it will tell us either: @@ -79,27 +74,33 @@ plugin parsedModule Diagnostic {_message, _range} -- addArgToMatch "foo" `bar arg1 arg2 = ...` -- => (`bar arg1 arg2 foo = ...`, 2) addArgToMatch :: T.Text -> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))) -> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int) + +-- NOTE: The code duplication within CPP clauses avoids a parse error with +-- `stylish-haskell`. #if MIN_VERSION_ghc(9,11,0) addArgToMatch name (L locMatch (Match xMatch ctxMatch (L l pats) rhs)) = -#else + let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name + newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName + -- The intention is to move `= ...` (right-hand side with equals) to the right so there's 1 space between + -- the newly added pattern and the rest + indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) + indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs } + in (L locMatch (Match xMatch ctxMatch (L l (pats <> [newPat])) (indentRhs rhs)), Prelude.length pats) +#elif MIN_VERSION_ghc(9,9,0) addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) = -#endif -#if MIN_VERSION_ghc(9,9,0) let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName -- The intention is to move `= ...` (right-hand side with equals) to the right so there's 1 space between -- the newly added pattern and the rest indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs } + in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs rhs)), Prelude.length pats) #else +addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) = let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name newPat = L (noAnnSrcSpanDP1 generatedSrcSpan) $ VarPat NoExtField (noLocA unqualName) indentRhs = id -#endif -#if MIN_VERSION_ghc(9,11,0) - in (L locMatch (Match xMatch ctxMatch (L l (pats <> [newPat])) (indentRhs rhs)), Prelude.length pats) -#else - in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs rhs)), Prelude.length pats) + in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs rhs)), Prelude.length pats) #endif -- Attempt to insert a binding pattern into each match for the given LHsDecl; succeeds only if the function is a FunBind. @@ -186,9 +187,9 @@ addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = , L wildCardAnn $ HsWildCardTy NoEpTok #else , L wildCardAnn $ HsWildCardTy noExtField -#endif +#endif ) -#elif MIN_VERSION_ghc(9,4,0) +#else wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem []) emptyComments) generatedSrcSpan arrowAnn = TokenLoc (epl 1) newArg = @@ -197,14 +198,6 @@ addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = , HsUnrestrictedArrow (L arrowAnn HsNormalTok) , L wildCardAnn $ HsWildCardTy noExtField ) -#else - wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem [AddRarrowAnn d1]) emptyComments) generatedSrcSpan - newArg = - ( SrcSpanAnn mempty generatedSrcSpan - , noAnn - , HsUnrestrictedArrow NormalSyntax - , L wildCardAnn $ HsWildCardTy noExtField - ) #endif -- NOTE if the location that the argument wants to be placed at is not one more than the number of arguments -- in the signature, then we return the original type signature. diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs index 17db1f0298..0f06fff2f7 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillTypeWildcard.hs @@ -2,78 +2,106 @@ module Development.IDE.Plugin.Plugins.FillTypeWildcard ( suggestFillTypeWildcard ) where -import Data.Char -import qualified Data.Text as T -import Language.LSP.Protocol.Types (Diagnostic (..), - TextEdit (TextEdit)) +import Control.Lens +import Data.Maybe (isJust) +import qualified Data.Text as T +import Development.IDE (FileDiagnostic (..), + fdStructuredMessageL, + printOutputable) +import Development.IDE.GHC.Compat hiding (vcat) +import Development.IDE.GHC.Compat.Error +import Development.IDE.Types.Diagnostics (_SomeStructuredMessage) +import GHC.Tc.Errors.Types (ErrInfo (..)) +import Language.LSP.Protocol.Types (Diagnostic (..), + TextEdit (TextEdit)) -suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)] -suggestFillTypeWildcard Diagnostic{_range=_range,..} +suggestFillTypeWildcard :: FileDiagnostic -> [(T.Text, TextEdit)] +suggestFillTypeWildcard diag@FileDiagnostic{fdLspDiagnostic = Diagnostic {..}} -- Foo.hs:3:8: error: -- * Found type wildcard `_' standing for `p -> p1 -> p' - | "Found type wildcard" `T.isInfixOf` _message - , " standing for " `T.isInfixOf` _message - , typeSignature <- extractWildCardTypeSignature _message - = [("Use type signature: ‘" <> typeSignature <> "’", TextEdit _range typeSignature)] + | isWildcardDiagnostic diag + , typeSignature <- extractWildCardTypeSignature diag = + [("Use type signature: ‘" <> typeSignature <> "’", TextEdit _range typeSignature)] | otherwise = [] +isWildcardDiagnostic :: FileDiagnostic -> Bool +isWildcardDiagnostic = + maybe False (isJust . (^? _TypeHole) . hole_sort) . diagReportHoleError + +-- | Extract the 'Hole' out of a 'FileDiagnostic' +diagReportHoleError :: FileDiagnostic -> Maybe Hole +diagReportHoleError diag = do + solverReport <- + diag + ^? fdStructuredMessageL + . _SomeStructuredMessage + . msgEnvelopeErrorL + . _TcRnMessage + . _TcRnSolverReport + . _1 + (hole, _) <- solverReport ^? reportContentL . _ReportHoleError + + Just hole + -- | Extract the type and surround it in parentheses except in obviously safe cases. -- -- Inferring when parentheses are actually needed around the type signature would -- require understanding both the precedence of the context of the hole and of -- the signature itself. Inserting them (almost) unconditionally is ugly but safe. -extractWildCardTypeSignature :: T.Text -> T.Text -extractWildCardTypeSignature msg - | enclosed || not isApp || isToplevelSig = sig - | otherwise = "(" <> sig <> ")" - where - msgSigPart = snd $ T.breakOnEnd "standing for " msg - (sig, rest) = T.span (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') $ msgSigPart - -- If we're completing something like ‘foo :: _’ parens can be safely omitted. - isToplevelSig = errorMessageRefersToToplevelHole rest - -- Parenthesize type applications, e.g. (Maybe Char). - isApp = T.any isSpace sig - -- Do not add extra parentheses to lists, tuples and already parenthesized types. - enclosed = - case T.uncons sig of +extractWildCardTypeSignature :: FileDiagnostic -> T.Text +extractWildCardTypeSignature diag = + case hole_ty <$> diagReportHoleError diag of + Just ty + | isTopLevel || not (isApp ty) || enclosed ty -> printOutputable ty + | otherwise -> "(" <> printOutputable ty <> ")" Nothing -> error "GHC provided invalid type" - Just (firstChr, _) -> not (T.null sig) && (firstChr, T.last sig) `elem` [('(', ')'), ('[', ']')] + where + isTopLevel :: Bool + isTopLevel = + maybe False errorMessageRefersToToplevelHole (diagErrInfoContext diag) + + isApp :: Type -> Bool + isApp (AppTy _ _) = True + isApp (TyConApp _ (_ : _)) = True + isApp (FunTy{}) = True + isApp _ = False + + enclosed :: Type -> Bool + enclosed (TyConApp con _) + | con == listTyCon || isTupleTyCon con = True + enclosed _ = False + +-- | Extract the 'ErrInfo' context out of a 'FileDiagnostic' and render it to +-- 'Text' +diagErrInfoContext :: FileDiagnostic -> Maybe T.Text +diagErrInfoContext diag = do + (_, detailedMsg) <- + diag + ^? fdStructuredMessageL + . _SomeStructuredMessage + . msgEnvelopeErrorL + . _TcRnMessageWithCtx + . _TcRnMessageWithInfo + let TcRnMessageDetailed err _ = detailedMsg + ErrInfo errInfoCtx _ = err + + Just (printOutputable errInfoCtx) --- | Detect whether user wrote something like @foo :: _@ or @foo :: (_, Int)@. +-- | Detect whether user wrote something like @foo :: _@ or @foo :: Maybe _@. -- The former is considered toplevel case for which the function returns 'True', -- the latter is not toplevel and the returned value is 'False'. -- --- When type hole is at toplevel then there’s a line starting with --- "• In the type signature" which ends with " :: _" like in the +-- When type hole is at toplevel then the ErrInfo context starts with +-- "In the type signature" which ends with " :: _" like in the -- following snippet: -- --- source/library/Language/Haskell/Brittany/Internal.hs:131:13: error: --- • Found type wildcard ‘_’ standing for ‘HsDecl GhcPs’ --- To use the inferred type, enable PartialTypeSignatures --- • In the type signature: decl :: _ --- In an equation for ‘splitAnnots’: --- splitAnnots m@HsModule {hsmodAnn, hsmodDecls} --- = undefined --- where --- ann :: SrcSpanAnnA --- decl :: _ --- L ann decl = head hsmodDecls --- • Relevant bindings include --- [REDACTED] +-- Just "In the type signature: decl :: _" -- -- When type hole is not at toplevel there’s a stack of where -- the hole was located ending with "In the type signature": -- --- source/library/Language/Haskell/Brittany/Internal.hs:130:20: error: --- • Found type wildcard ‘_’ standing for ‘GhcPs’ --- To use the inferred type, enable PartialTypeSignatures --- • In the first argument of ‘HsDecl’, namely ‘_’ --- In the type ‘HsDecl _’ --- In the type signature: decl :: HsDecl _ --- • Relevant bindings include --- [REDACTED] +-- Just "In the first argument of ‘HsDecl’\nIn the type signature: decl :: HsDecl _" errorMessageRefersToToplevelHole :: T.Text -> Bool errorMessageRefersToToplevelHole msg = - not (T.null prefix) && " :: _" `T.isSuffixOf` T.takeWhile (/= '\n') rest - where - (prefix, rest) = T.breakOn "• In the type signature:" msg + "In the type signature:" `T.isPrefixOf` msg + && " :: _" `T.isSuffixOf` T.takeWhile (/= '\n') msg diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index f3756506e9..0fb8b61f83 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} @@ -701,6 +701,10 @@ typeWildCardActionTests = testGroup "type wildcard actions" "func::Integer -> Integer -> Integer" , "func x y = x + y" ] + , testNoUseTypeSignature "ignores typed holes" + [ "func :: a -> a" + , "func x = _" + ] , testGroup "add parens if hole is part of bigger type" [ testUseTypeSignature "subtype 1" [ "func :: _ -> Integer -> Integer" @@ -736,19 +740,33 @@ typeWildCardActionTests = testGroup "type wildcard actions" -- | Test session of given name, checking action "Use type signature..." -- on a test file with given content and comparing to expected result. testUseTypeSignature name textIn textOut = testSession name $ do - let fileStart = "module Testing where" + let expectedContentAfterAction = T.unlines $ fileStart : textOut content = T.unlines $ fileStart : textIn - expectedContentAfterAction = T.unlines $ fileStart : textOut doc <- createDoc "Testing.hs" "haskell" content - _ <- waitForDiagnostics - actionsOrCommands <- getAllCodeActions doc - [addSignature] <- pure [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands - , "Use type signature" `T.isPrefixOf` actionTitle - ] + + (Just addSignature) <- getUseTypeSigAction doc executeCodeAction addSignature contentAfterAction <- documentContents doc liftIO $ expectedContentAfterAction @=? contentAfterAction + testNoUseTypeSignature name textIn = testSession name $ do + let content = T.unlines $ fileStart : textIn + doc <- createDoc "Testing.hs" "haskell" content + codeAction <- getUseTypeSigAction doc + liftIO $ Nothing @=? codeAction + + fileStart = "module Testing where" + + getUseTypeSigAction docIn = do + _ <- waitForDiagnostics + actionsOrCommands <- getAllCodeActions docIn + + let addSignatures = + [ action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands + , "Use type signature" `T.isPrefixOf` actionTitle + ] + pure $ listToMaybe addSignatures + removeImportTests :: TestTree removeImportTests = testGroup "remove import actions" @@ -1157,7 +1175,7 @@ extendImportTests = testGroup "extend import actions" , "x :: (:~:) [] []" , "x = Refl" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 3 4) (Position 3 8)) [ "Add (:~:)(..) to the import list of Data.Type.Equality" , "Add type (:~:)(Refl) to the import list of Data.Type.Equality"] (T.unlines @@ -1221,7 +1239,7 @@ extendImportTests = testGroup "extend import actions" , "import ModuleA as A (stuffB)" , "main = print (stuffB .* stuffB)" ]) - (Range (Position 2 17) (Position 2 18)) + (Range (Position 2 22) (Position 2 24)) ["Add (.*) to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1235,7 +1253,7 @@ extendImportTests = testGroup "extend import actions" , "import Data.List.NonEmpty (fromList)" , "main = case (fromList []) of _ :| _ -> pure ()" ]) - (Range (Position 2 5) (Position 2 6)) + (Range (Position 2 31) (Position 2 33)) [ "Add NonEmpty((:|)) to the import list of Data.List.NonEmpty" , "Add NonEmpty(..) to the import list of Data.List.NonEmpty" ] @@ -1252,7 +1270,7 @@ extendImportTests = testGroup "extend import actions" , "import Data.Maybe (catMaybes)" , "x = Just 10" ]) - (Range (Position 3 5) (Position 2 6)) + (Range (Position 3 4) (Position 3 8)) [ "Add Maybe(Just) to the import list of Data.Maybe" , "Add Maybe(..) to the import list of Data.Maybe" ] @@ -1359,8 +1377,7 @@ extendImportTests = testGroup "extend import actions" [ "import Data.Monoid (First (..))" , "f = (First Nothing) <> mempty" ]) - , brokenForGHC94 "On GHC 9.4, the error messages with -fdefer-type-errors don't have necessary imported target srcspan info." $ - testSession "extend single line qualified import with value" $ template + , testSession "extend single line qualified import with value" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where" , "stuffA :: Double" @@ -1485,7 +1502,7 @@ extendImportTests = testGroup "extend import actions" , "import ModuleA ()" , "foo = bar" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 3 6) (Position 3 9)) ["Add bar to the import list of ModuleA", "Add bar to the import list of ModuleB"] (T.unlines @@ -1502,7 +1519,7 @@ extendImportTests = testGroup "extend import actions" , "x :: (:~:) [] []" , "x = Refl" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 3 4) (Position 3 8)) [ "Add type (:~:)(Refl) to the import list of Data.Type.Equality" , "Add (:~:)(..) to the import list of Data.Type.Equality"] (T.unlines @@ -1552,8 +1569,7 @@ extendImportTests = testGroup "extend import actions" ) (Range (Position 2 3) (Position 2 7)) ) - , ignoreForGhcVersions [GHC94] "Diagnostic message has no suggestions" $ - testSession "type constructor name same as data constructor name" $ template + , testSession "type constructor name same as data constructor name" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where" , "newtype Foo = Foo Int" @@ -1855,7 +1871,7 @@ suggestImportTests = testGroup "suggest import actions" suggestAddRecordFieldImportTests :: TestTree suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields when using OverloadedRecordDot" [ testGroup "The field is suggested when an instance resolution failure occurs" - ([ ignoreForGhcVersions [GHC94, GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest + ([ ignoreForGhcVersions [GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest ] ++ [ theTestIndirect qualifiedGhcRecords polymorphicType @@ -2427,7 +2443,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions" docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start) _ <- waitForDiagnostics action <- pickActionWithTitle "Define select :: Int -> Bool" - =<< getCodeActions docB (R 1 0 0 50) + =<< getCodeActions docB (R 1 8 1 14) executeCodeAction action contentAfterAction <- documentContents docB liftIO $ contentAfterAction @?= T.unlines expected @@ -2451,7 +2467,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions" docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start) _ <- waitForDiagnostics action <- pickActionWithTitle "Define select :: Int -> Bool" - =<< getCodeActions docB (R 1 0 0 50) + =<< getCodeActions docB (R 1 8 1 14) executeCodeAction action contentAfterAction <- documentContents docB liftIO $ contentAfterAction @?= T.unlines expected @@ -2619,9 +2635,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f = 1" ] - (if ghcVersion >= GHC94 - then [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the type variable", Nothing) ] - else [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the following constraint", Nothing) ]) + [ (DiagnosticSeverity_Warning, (3, 4), "Defaulting the type variable", Nothing) ] "Add type annotation ‘Integer’ to ‘1’" [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A (f) where" @@ -2638,9 +2652,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , " let x = 3" , " in x" ] - (if ghcVersion >= GHC94 - then [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the type variable", Nothing) ] - else [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the following constraint", Nothing) ]) + [ (DiagnosticSeverity_Warning, (4, 12), "Defaulting the type variable", Nothing) ] "Add type annotation ‘Integer’ to ‘3’" [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A where" @@ -2658,9 +2670,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , " let x = let y = 5 in y" , " in x" ] - (if ghcVersion >= GHC94 - then [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the type variable", Nothing) ] - else [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the following constraint", Nothing) ]) + [ (DiagnosticSeverity_Warning, (4, 20), "Defaulting the type variable", Nothing) ] "Add type annotation ‘Integer’ to ‘5’" [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A where" @@ -2679,15 +2689,9 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f = seq \"debug\" traceShow \"debug\"" ] - (if ghcVersion >= GHC94 - then - [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the type variable", Nothing) - , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the type variable", Nothing) - ] - else - [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the following constraint", Nothing) - , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the following constraint", Nothing) - ]) + [ (DiagnosticSeverity_Warning, (6, 8), "Defaulting the type variable", Nothing) + , (DiagnosticSeverity_Warning, (6, 16), "Defaulting the type variable", Nothing) + ] ("Add type annotation ‘" <> stringLit <> "’ to ‘\"debug\"’") [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2707,9 +2711,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f a = traceShow \"debug\" a" ] - (if ghcVersion >= GHC94 - then [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the type variable", Nothing) ] - else [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the following constraint", Nothing) ]) + [ (DiagnosticSeverity_Warning, (6, 6), "Defaulting the type variable", Nothing) ] ("Add type annotation ‘" <> stringLit <> "’ to ‘\"debug\"’") [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2729,9 +2731,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))" ] - (if ghcVersion >= GHC94 - then [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the type variable", Nothing) ] - else [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the following constraint", Nothing) ]) + [ (DiagnosticSeverity_Warning, (6, 54), "Defaulting the type variable", Nothing) ] ("Add type annotation ‘"<> stringLit <>"’ to ‘\"debug\"’") [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2768,7 +2768,7 @@ fixConstructorImportTests = testGroup "fix import actions" [ "module ModuleB where" , "import ModuleA(Constructor)" ]) - (Range (Position 1 10) (Position 1 11)) + (Range (Position 1 15) (Position 1 26)) "Fix import of A(Constructor)" (T.unlines [ "module ModuleB where" @@ -3054,6 +3054,21 @@ addFunctionConstraintTests = let , "eq (Pair x y) (Pair x' y') = x == x' && y == y'" ] + -- See https://github.com/haskell/haskell-language-server/issues/4648 + -- When haddock comment appears after the =>, code action was introducing the + -- new constraint in the comment + incompleteConstraintSourceCodeWithCommentInTypeSignature :: T.Text -> T.Text + incompleteConstraintSourceCodeWithCommentInTypeSignature constraint = + T.unlines + + [ "module Testing where" + , "foo " + , " :: ("<> constraint <> ") =>" + , " -- This is a comment" + , " m ()" + , "foo = pure ()" + ] + missingMonadConstraint constraint = T.unlines [ "module Testing where" , "f :: " <> constraint <> "m ()" @@ -3097,6 +3112,11 @@ addFunctionConstraintTests = let "Add `Eq b` to the context of the type signature for `eq`" (incompleteConstraintSourceCodeWithNewlinesInTypeSignature "Eq a") (incompleteConstraintSourceCodeWithNewlinesInTypeSignature "Eq a, Eq b") + , checkCodeAction + "preexisting constraint, with haddock comment in type signature" + "Add `Applicative m` to the context of the type signature for `foo`" + (incompleteConstraintSourceCodeWithCommentInTypeSignature "") + (incompleteConstraintSourceCodeWithCommentInTypeSignature " Applicative m") , checkCodeAction "missing Monad constraint" "Add `Monad m` to the context of the type signature for `f`" @@ -3359,7 +3379,7 @@ addSigActionTests = let executeCodeAction chosenAction modifiedCode <- documentContents doc liftIO $ expectedCode @=? modifiedCode - issue806 = if ghcVersion >= GHC912 then + issue806 = if ghcVersion >= GHC910 then "hello = print" >:: "hello :: GHC.Types.ZonkAny 0 -> IO ()" -- GHC now returns ZonkAny 0 instead of Any. https://gitlab.haskell.org/ghc/ghc/-/issues/25895 else "hello = print" >:: "hello :: GHC.Types.Any -> IO ()" -- Documents current behavior outlined in #806 @@ -3405,8 +3425,7 @@ exportUnusedTests = testGroup "export unused actions" ] (R 2 0 2 11) "Export ‘bar’" - , ignoreForGhcVersions [GHC94] "Diagnostic message has no suggestions" $ - testSession "type is exported but not the constructor of same name" $ templateNoAction + , testSession "type is exported but not the constructor of same name" $ templateNoAction [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo) where" , "data Foo = Foo" @@ -4049,6 +4068,3 @@ pattern R x y x' y' = Range (Position x y) (Position x' y') -- @/var@ withTempDir :: (FilePath -> IO a) -> IO a withTempDir f = System.IO.Extra.withTempDir $ (canonicalizePath >=> f) - -brokenForGHC94 :: String -> TestTree -> TestTree -brokenForGHC94 = knownBrokenForGhcVersions [GHC94] diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 7cc1122982..0ba6bc7975 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -8,7 +8,6 @@ module Ide.Plugin.Rename (descriptor, E.Log) where -import Compat.HieTypes import Control.Lens ((^.)) import Control.Monad import Control.Monad.Except (ExceptT, throwError) @@ -25,7 +24,6 @@ import Data.List.NonEmpty (NonEmpty ((:|)), import qualified Data.Map as M import Data.Maybe import Data.Mod.Word -import qualified Data.Set as S import qualified Data.Text as T import Development.IDE (Recorder, WithPriority, usePropertyAction) @@ -42,7 +40,14 @@ import qualified Development.IDE.GHC.ExactPrint as E import Development.IDE.Plugin.CodeAction import Development.IDE.Spans.AtPoint import Development.IDE.Types.Location +import GHC.Iface.Ext.Types (HieAST (..), + HieASTs (..), + NodeOrigin (..), + SourcedNodeInfo (..)) +import GHC.Iface.Ext.Utils (generateReferencesMap) +import HieDb ((:.) (..)) import HieDb.Query +import HieDb.Types (RefRow (refIsGenerated)) import Ide.Plugin.Error import Ide.Plugin.Properties import Ide.PluginUtils @@ -196,6 +201,8 @@ refsAtName state nfp name = do dbRefs <- case nameModule_maybe name of Nothing -> pure [] Just mod -> liftIO $ mapMaybe rowToLoc <$> withHieDb (\hieDb -> + -- See Note [Generated references] + filter (\(refRow HieDb.:. _) -> refIsGenerated refRow) <$> findReferences hieDb True @@ -230,15 +237,29 @@ handleGetHieAst state nfp = -- which is bad (see https://github.com/haskell/haskell-language-server/issues/3799) fmap removeGenerated $ runActionE "Rename.GetHieAst" state $ useE GetHieAst nfp --- | We don't want to rename in code generated by GHC as this gives false positives. --- So we restrict the HIE file to remove all the generated code. +{- Note [Generated references] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC inserts `Use`s of record constructor everywhere where its record selectors are used, +which leads to record fields being renamed whenever corresponding constructor is renamed. +see https://github.com/haskell/haskell-language-server/issues/2915 +To work around this, we filter out compiler-generated references. +-} removeGenerated :: HieAstResult -> HieAstResult -removeGenerated HAR{..} = HAR{hieAst = go hieAst,..} +removeGenerated HAR{..} = + HAR{hieAst = sourceOnlyAsts, refMap = sourceOnlyRefMap, ..} where - go :: HieASTs a -> HieASTs a - go hf = - HieASTs (fmap goAst (getAsts hf)) - goAst (Node nsi sp xs) = Node (SourcedNodeInfo $ M.restrictKeys (getSourcedNodeInfo nsi) (S.singleton SourceInfo)) sp (map goAst xs) + goAsts :: HieASTs a -> HieASTs a + goAsts (HieASTs asts) = HieASTs (fmap goAst asts) + + goAst :: HieAST a -> HieAST a + goAst (Node (SourcedNodeInfo sniMap) sp children) = + let sourceOnlyNodeInfos = SourcedNodeInfo $ M.delete GeneratedInfo sniMap + in Node sourceOnlyNodeInfos sp $ map goAst children + + sourceOnlyAsts = goAsts hieAst + -- Also need to regenerate the RefMap, because the one in HAR + -- is generated from HieASTs containing GeneratedInfo + sourceOnlyRefMap = generateReferencesMap $ getAsts sourceOnlyAsts collectWith :: (Hashable a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)] collectWith f = map (\(a :| as) -> (f a, HS.fromList (a:as))) . groupWith f . HS.toList diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs index 5f7fb818ff..b935e6563f 100644 --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -24,6 +24,11 @@ tests :: TestTree tests = testGroup "Rename" [ goldenWithRename "Data constructor" "DataConstructor" $ \doc -> rename doc (Position 0 15) "Op" + , goldenWithRename "Data constructor with fields" "DataConstructorWithFields" $ \doc -> + rename doc (Position 1 13) "FooRenamed" + , knownBrokenForGhcVersions [GHC96, GHC98] "renaming Constructor{..} with RecordWildcard removes .." $ + goldenWithRename "Data constructor with fields" "DataConstructorWithFieldsRecordWildcards" $ \doc -> + rename doc (Position 1 13) "FooRenamed" , goldenWithRename "Exported function" "ExportedFunction" $ \doc -> rename doc (Position 2 1) "quux" , goldenWithRename "Field Puns" "FieldPuns" $ \doc -> @@ -113,7 +118,7 @@ goldenWithRename title path act = goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] }) renamePlugin title testDataDir path "expected" "hs" act -renameExpectError :: (TResponseError Method_TextDocumentRename) -> TextDocumentIdentifier -> Position -> Text -> Session () +renameExpectError :: TResponseError Method_TextDocumentRename -> TextDocumentIdentifier -> Position -> Text -> Session () renameExpectError expectedError doc pos newName = do let params = RenameParams Nothing doc pos newName rsp <- request SMethod_TextDocumentRename params diff --git a/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.expected.hs b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.expected.hs new file mode 100644 index 0000000000..5fc38c7f01 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.expected.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE NamedFieldPuns #-} +data Foo = FooRenamed { a :: Int, b :: Bool } + +foo1 :: Foo +foo1 = FooRenamed { a = 1, b = True } + +foo2 :: Foo +foo2 = FooRenamed 1 True + +fun1 :: Foo -> Int +fun1 FooRenamed {a} = a + +fun2 :: Foo -> Int +fun2 FooRenamed {a = i} = i diff --git a/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.hs b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.hs new file mode 100644 index 0000000000..abd8031096 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFields.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE NamedFieldPuns #-} +data Foo = Foo { a :: Int, b :: Bool } + +foo1 :: Foo +foo1 = Foo { a = 1, b = True } + +foo2 :: Foo +foo2 = Foo 1 True + +fun1 :: Foo -> Int +fun1 Foo {a} = a + +fun2 :: Foo -> Int +fun2 Foo {a = i} = i diff --git a/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.expected.hs b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.expected.hs new file mode 100644 index 0000000000..b5dd83cecb --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.expected.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} +data Foo = FooRenamed { a :: Int, b :: Bool } + +fun :: Foo -> Int +fun FooRenamed {..} = a diff --git a/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.hs b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.hs new file mode 100644 index 0000000000..8e624b0816 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/DataConstructorWithFieldsRecordWildcards.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} +data Foo = Foo { a :: Int, b :: Bool } + +fun :: Foo -> Int +fun Foo {..} = a diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index fe72d945f4..2e39ffcd98 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -465,11 +465,7 @@ suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) = ] | L (locA -> l) r <- rds_rules, pos `isInsideSrcSpan` l, -#if MIN_VERSION_ghc(9,5,0) let HsRule {rd_name = L _ rn} = r, -#else - let HsRule {rd_name = L _ (_, rn)} = r, -#endif let ruleName = unpackFS rn ] where @@ -736,7 +732,6 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} ideclPkgQual = NoRawPkgQual -#if MIN_VERSION_ghc(9,5,0) ideclImportList = Nothing ideclExt = GHCGHC.XImportDeclPass { ideclAnn = @@ -748,11 +743,6 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} , ideclSourceText = ideclSourceSrc , ideclImplicit = ideclImplicit } -#else - ideclExt = GHCGHC.EpAnnNotUsed - ideclHiding = Nothing -#endif - reuseParsedModule :: IdeState -> NormalizedFilePath -> IO (FixityEnv, Annotated GHCGHC.ParsedSource) reuseParsedModule state f = do diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs index b8b07e667f..1bbba24df2 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -43,6 +44,8 @@ import Development.IDE.Core.Shake (ShakeExtras (..), getVirtualFile) import Development.IDE.GHC.Compat hiding (Warning) import Development.IDE.GHC.Compat.Util (mkFastString) +import GHC.Iface.Ext.Types (HieASTs (getAsts), + pattern HiePath) import Ide.Logger (logWith) import Ide.Plugin.Error (PluginError (PluginInternalError), getNormalizedFilePathE, diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs index d9bfc4449d..e93cefb711 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs @@ -20,6 +20,10 @@ import qualified Data.Set as Set import Data.Text (Text, unpack) import Development.IDE (HieKind (HieFresh, HieFromDisk)) import Development.IDE.GHC.Compat +import GHC.Iface.Ext.Types (BindType (..), + ContextInfo (..), + DeclType (..), HieType (..), + HieTypeFlat, TypeIndex) import Ide.Plugin.SemanticTokens.Types import Ide.Plugin.SemanticTokens.Utils (mkRange) import Language.LSP.Protocol.Types (LspEnum (knownValues), diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs index fb7fdd9e71..5875ebfa8d 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs @@ -11,6 +11,9 @@ import Data.Text (Text) import Development.IDE.Core.PositionMapping (PositionMapping, toCurrentRange) import Development.IDE.GHC.Compat +import GHC.Iface.Ext.Types (ContextInfo, Identifier, + IdentifierDetails (..)) +import GHC.Iface.Ext.Utils (RefMap) import Ide.Plugin.SemanticTokens.Mappings import Ide.Plugin.SemanticTokens.Types (HieFunMaskKind, HsSemanticTokenType (TModule), diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs index e9e8034ce3..be793cfe7a 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -16,8 +16,8 @@ import Development.IDE (Action, usePropertyAction) import GHC.TypeLits (KnownSymbol) import Ide.Plugin.Properties (KeyNameProxy, NotElem, Properties, - PropertyKey (type PropertyKey), - PropertyType (type TEnum), + PropertyKey (PropertyKey), + PropertyType (TEnum), defineEnumProperty, emptyProperties) import Ide.Plugin.SemanticTokens.Types diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs index 2ed11be333..b6142fb39c 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs @@ -22,6 +22,10 @@ import Data.Text.Utf16.Rope.Mixed (Rope) import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (realSrcSpanToCodePointRange) +import GHC.Iface.Ext.Types (HieAST (..), Identifier, + NodeInfo (..), + NodeOrigin (..), + SourcedNodeInfo (..)) import Ide.Plugin.SemanticTokens.Types (HsSemanticTokenType (TModule), RangeHsSemanticTokenTypes (..)) import Language.LSP.Protocol.Types (Position (Position), diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs index 7f445bf7ac..da59c28d29 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs @@ -10,16 +10,16 @@ module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) import qualified Data.Array as A import Data.Default (Default (def)) +import Data.Text (Text) import Development.IDE (Pretty (pretty), RuleResult) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (loc) import Development.IDE.Graph.Classes (Hashable) import GHC.Generics (Generic) -import Language.LSP.Protocol.Types --- import template haskell -import Data.Text (Text) +import GHC.Iface.Ext.Types (TypeIndex) import Ide.Plugin.Error (PluginError) import Language.Haskell.TH.Syntax (Lift) +import Language.LSP.Protocol.Types -- !!!! order of declarations matters deriving enum and ord diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs index 52cd56a21f..c545d8941a 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Utils.hs @@ -10,6 +10,11 @@ import Data.ByteString.Char8 (unpack) import qualified Data.Map.Strict as Map import Development.IDE (Position (..), Range (..)) import Development.IDE.GHC.Compat +import GHC.Iface.Ext.Types (BindType (..), ContextInfo (..), + DeclType (..), Identifier, + IdentifierDetails (..), + RecFieldContext (..), Span) +import GHC.Iface.Ext.Utils (RefMap) import Prelude hiding (length, span) deriving instance Show DeclType diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 8955b76e3c..de468e2a87 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -38,14 +38,14 @@ import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Text as T import Development.IDE -import Development.IDE.Core.FileStore (getVersionedTextDoc) +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.ExactPrint import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint import GHC.Exts -import qualified GHC.Runtime.Loader as Loader +import qualified GHC.Runtime.Loader as Loader import qualified GHC.Types.Error as Error import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.Plugin.Splice.Types @@ -58,9 +58,7 @@ import Language.LSP.Protocol.Types import Data.Foldable (Foldable (foldl')) #endif -#if MIN_VERSION_ghc(9,4,1) import GHC.Data.Bag (Bag) -#endif #if MIN_VERSION_ghc(9,9,0) import GHC.Parser.Annotation (EpAnn (..)) @@ -294,11 +292,9 @@ data SpliceClass where OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass IsHsDecl :: SpliceClass -#if MIN_VERSION_ghc(9,5,0) data HsSpliceCompat pass = UntypedSplice (HsUntypedSplice pass) | TypedSplice (LHsExpr pass) -#endif class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where @@ -307,43 +303,24 @@ class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast wher expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars) instance HasSplice AnnListItem HsExpr where -#if MIN_VERSION_ghc(9,5,0) type SpliceOf HsExpr = HsSpliceCompat matchSplice _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl) matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl) -#else - type SpliceOf HsExpr = HsSplice - matchSplice _ (HsSpliceE _ spl) = Just spl -#endif - matchSplice _ _ = Nothing -#if MIN_VERSION_ghc(9,5,0) + matchSplice _ _ = Nothing expandSplice _ (UntypedSplice e) = fmap (first Right) $ rnUntypedSpliceExpr e expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice e -#else - expandSplice _ = fmap (first Right) . rnSpliceExpr -#endif instance HasSplice AnnListItem Pat where -#if MIN_VERSION_ghc(9,5,0) type SpliceOf Pat = HsUntypedSplice -#else - type SpliceOf Pat = HsSplice -#endif matchSplice _ (SplicePat _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = -#if MIN_VERSION_ghc(9,5,0) fmap (first (Left . unLoc . utsplice_result . snd )) . -#endif rnSplicePat instance HasSplice AnnListItem HsType where -#if MIN_VERSION_ghc(9,5,0) type SpliceOf HsType = HsUntypedSplice -#else - type SpliceOf HsType = HsSplice -#endif matchSplice _ (HsSpliceTy _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = fmap (first Right) . rnSpliceType @@ -418,14 +395,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e pure resl where dflags = hsc_dflags hscEnv - -#if MIN_VERSION_ghc(9,4,1) showErrors = showBag -#else - showErrors = show -#endif -#if MIN_VERSION_ghc(9,4,1) showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String showBag = show . fmap (fmap toDiagnosticMessage) @@ -433,15 +404,12 @@ toDiagnosticMessage :: forall a. Error.Diagnostic a => a -> Error.DiagnosticMess toDiagnosticMessage message = Error.DiagnosticMessage { diagMessage = Error.diagnosticMessage -#if MIN_VERSION_ghc(9,5,0) (Error.defaultDiagnosticOpts @a) -#endif message , diagReason = Error.diagnosticReason message , diagHints = Error.diagnosticHints message } -#endif -- | FIXME: Is thereAny "clever" way to do this exploiting TTG? unRenamedE :: @@ -458,11 +426,7 @@ unRenamedE dflags expr = do showSDoc dflags $ ppr expr pure expr' where -#if MIN_VERSION_ghc(9,4,1) showErrors = showBag . Error.getMessages -#else - showErrors = show -#endif data SearchResult r = Continue | Stop | Here r @@ -510,12 +474,8 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = do (L (AsSrcSpan l@(RealSrcSpan spLoc _)) expr :: LHsExpr GhcPs) | spanIsRelevant l -> case expr of -#if MIN_VERSION_ghc(9,5,0) HsTypedSplice{} -> Here (spLoc, Expr) HsUntypedSplice{} -> Here (spLoc, Expr) -#else - HsSpliceE {} -> Here (spLoc, Expr) -#endif _ -> Continue _ -> Stop ) diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index a1efb7f150..77c9817dba 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -2,7 +2,6 @@ {-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Stan (descriptor, Log) where -import Compat.HieTypes (HieFile (..)) import Control.DeepSeq (NFData) import Control.Monad (void) import Control.Monad.IO.Class (liftIO) @@ -14,6 +13,7 @@ import qualified Data.Text as T import Development.IDE import Development.IDE.Core.Rules (getHieFile) import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat (HieFile (..)) import GHC.Generics (Generic) import Ide.Plugin.Config (PluginConfig (..)) import Ide.Types (PluginDescriptor (..), PluginId, diff --git a/release/upload.sh b/release/upload.sh index 29f6849757..22dc6d438d 100755 --- a/release/upload.sh +++ b/release/upload.sh @@ -35,7 +35,7 @@ fi echo HLS version $ver -host="gitlab-storage.haskell.org" +host="gitlab.haskell.org:2222" usage() { echo "Usage: [rel_name=] SIGNING_KEY= $0 " diff --git a/scripts/release/create-yaml-snippet.sh b/scripts/release/create-yaml-snippet.sh index ed0cd6681b..6ee25b01b5 100644 --- a/scripts/release/create-yaml-snippet.sh +++ b/scripts/release/create-yaml-snippet.sh @@ -28,6 +28,14 @@ cat < /dev/stdout dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-deb10.tar.xz dlSubdir: haskell-language-server-$RELEASE dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-deb10.tar.xz" | awk '{ print $1 }') + '(>= 11 && < 12)': &hls-${RELEASE//./}-64-deb11 + dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-deb11.tar.xz + dlSubdir: haskell-language-server-$RELEASE + dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-deb11.tar.xz" | awk '{ print $1 }') + '>= 12': &hls-${RELEASE//./}-64-deb12 + dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-deb12.tar.xz + dlSubdir: haskell-language-server-$RELEASE + dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-deb12.tar.xz" | awk '{ print $1 }') unknown_versioning: &hls-${RELEASE//./}-64-deb11 dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-deb11.tar.xz dlSubdir: haskell-language-server-$RELEASE @@ -54,30 +62,27 @@ cat < /dev/stdout dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-mint202.tar.xz dlSubdir: haskell-language-server-$RELEASE dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-mint202.tar.xz" | awk '{ print $1 }') - '>= 21': *hls-${RELEASE//./}-64-ubuntu22 - Linux_Fedora: - '< 33': &hls-${RELEASE//./}-64-fedora27 - dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-fedora27.tar.xz + '>= 21': + dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-mint213.tar.xz dlSubdir: haskell-language-server-$RELEASE - dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-fedora27.tar.xz" | awk '{ print $1 }') - '>= 33': &hls-${RELEASE//./}-64-fedora33 + dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-mint213.tar.xz" | awk '{ print $1 }') + Linux_Fedora: + '(>= 33 && < 40)': &hls-${RELEASE//./}-64-fedora33 dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-fedora33.tar.xz dlSubdir: haskell-language-server-$RELEASE dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-fedora33.tar.xz" | awk '{ print $1 }') - unknown_versioning: *hls-${RELEASE//./}-64-fedora27 - Linux_CentOS: - '( >= 7 && < 8 )': &hls-${RELEASE//./}-64-centos - dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-centos7.tar.xz + '>= 40': &hls-${RELEASE//./}-64-fedora40 + dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-fedora40.tar.xz dlSubdir: haskell-language-server-$RELEASE - dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-centos7.tar.xz" | awk '{ print $1 }') - unknown_versioning: *hls-${RELEASE//./}-64-centos - Linux_RedHat: - unknown_versioning: *hls-${RELEASE//./}-64-centos + dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-fedora40.tar.xz" | awk '{ print $1 }') + unknown_versioning: *hls-${RELEASE//./}-64-unknown Linux_UnknownLinux: - unknown_versioning: + unknown_versioning: &hls-${RELEASE//./}-64-unknown dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-linux-unknown.tar.xz dlSubdir: haskell-language-server-$RELEASE dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-linux-unknown.tar.xz" | awk '{ print $1 }') + Linux_RedHat: + unknown_versioning: *hls-${RELEASE//./}-64-unknown Darwin: unknown_versioning: dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-apple-darwin.tar.xz @@ -87,11 +92,6 @@ cat < /dev/stdout unknown_versioning: dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-mingw64.zip dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-mingw64.zip" | awk '{ print $1 }') - FreeBSD: - unknown_versioning: - dlUri: https://downloads.haskell.org/~hls/haskell-language-server-$RELEASE/haskell-language-server-$RELEASE-x86_64-freebsd.tar.xz - dlSubdir: haskell-language-server-$RELEASE - dlHash: $(sha256sum "haskell-language-server-$RELEASE-x86_64-freebsd.tar.xz" | awk '{ print $1 }') A_ARM64: Linux_UnknownLinux: unknown_versioning: diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 87a1af7392..4c135fc48b 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -224,7 +224,7 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins let pId = "codeRange" in CodeRange.descriptor (pluginRecorder pId) pId: #endif #if hls_changeTypeSignature - ChangeTypeSignature.descriptor "changeTypeSignature" : + let pId = "changeTypeSignature" in ChangeTypeSignature.descriptor (pluginRecorder pId) pId : #endif #if hls_gadt GADT.descriptor "gadt" : diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs index 733da2e557..be7f35e455 100644 --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -33,6 +33,7 @@ data Arguments | BiosMode BiosAction | Ghcide GhcideArguments | VSCodeExtensionSchemaMode + | PluginsCustomConfigMarkdownReferenceMode | DefaultConfigurationMode | PrintLibDir @@ -69,6 +70,7 @@ getArguments exeName plugins = execParser opts <|> hsubparser ( command "vscode-extension-schema" extensionSchemaCommand <> command "generate-default-config" generateDefaultConfigCommand + <> command "plugins-custom-config-markdown-reference" pluginsCustomConfigMarkdownReferenceCommand ) <|> listPluginsParser <|> BiosMode <$> biosParser @@ -86,6 +88,9 @@ getArguments exeName plugins = execParser opts generateDefaultConfigCommand = info (pure DefaultConfigurationMode) (fullDesc <> progDesc "Print config supported by the server with default values") + pluginsCustomConfigMarkdownReferenceCommand = + info (pure PluginsCustomConfigMarkdownReferenceMode) + (fullDesc <> progDesc "Print markdown reference for plugins custom config") printVersionParser :: String -> Parser PrintVersion printVersionParser exeName = diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index 33b1d51a11..f122b53fa6 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -15,6 +15,7 @@ import Data.Function ((&)) import Data.List (sortOn) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T (putStrLn) import Data.Text.Lazy.Encoding (decodeUtf8) import qualified Data.Text.Lazy.IO as LT import Development.IDE.Core.Rules hiding (Log) @@ -28,7 +29,8 @@ import HIE.Bios.Types hiding (Log) import qualified HIE.Bios.Types as HieBios import Ide.Arguments import Ide.Logger as G -import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, +import Ide.Plugin.ConfigUtils (pluginsCustomConfigToMarkdownTables, + pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) import Ide.Types (IdePlugins, PluginId (PluginId), describePlugin, ipMap, pluginId) @@ -103,6 +105,8 @@ defaultMain recorder args idePlugins = do VSCodeExtensionSchemaMode -> do LT.putStrLn $ decodeUtf8 $ encodePrettySorted $ pluginsToVSCodeExtensionSchema idePlugins + PluginsCustomConfigMarkdownReferenceMode -> do + T.putStrLn $ pluginsCustomConfigToMarkdownTables idePlugins DefaultConfigurationMode -> do LT.putStrLn $ decodeUtf8 $ encodePrettySorted $ pluginsToDefaultConfig idePlugins PrintLibDir -> do diff --git a/stack-lts22.yaml b/stack-lts22.yaml index 8c5ba4364c..429125333a 100644 --- a/stack-lts22.yaml +++ b/stack-lts22.yaml @@ -2,12 +2,10 @@ resolver: lts-22.43 # ghc-9.6.6 packages: - . - - ./hie-compat - ./hls-graph - ./ghcide/ - ./hls-plugin-api - ./hls-test-utils - # - ./shake-bench ghc-options: "$everything": -haddock @@ -15,12 +13,15 @@ ghc-options: allow-newer: true allow-newer-deps: - extensions + # stan dependencies + - directory-ospath-streaming extra-deps: - Diff-0.5 - floskell-0.11.1 - - hiedb-0.6.0.2 - - hie-bios-0.15.0 + - hiedb-0.7.0.0 + - hie-bios-0.17.0 + - hie-compat-0.3.1.2 - implicit-hie-0.1.4.0 - lsp-2.7.0.0 - lsp-test-0.17.1.0 @@ -29,7 +30,7 @@ extra-deps: - retrie-1.2.3 # stan and friends - - stan-0.1.3.0 + - stan-0.2.1.0 - dir-traverse-0.2.3.0 - extensions-0.1.0.1 - tomland-1.3.3.2 @@ -37,8 +38,9 @@ extra-deps: - trial-optparse-applicative-0.0.0.0 - trial-tomland-0.0.0.0 - validation-selective-0.2.0.0 - - cabal-add-0.1 + - cabal-add-0.2 - cabal-install-parsers-0.6.1.1 + - directory-ospath-streaming-0.2.2 configure-options: @@ -54,8 +56,9 @@ flags: ghc-lib: true retrie: BuildExecutable: false - cabal-add: - cabal-syntax: true + # stan dependencies + directory-ospath-streaming: + os-string: false nix: packages: [icu libcxx zlib] diff --git a/stack.yaml b/stack.yaml index 085de85f97..43cb239b34 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,12 +2,10 @@ resolver: lts-23.18 # ghc-9.8.4 packages: - . - - ./hie-compat - ./hls-graph - ./ghcide/ - ./hls-plugin-api - ./hls-test-utils - # - ./shake-bench ghc-options: "$everything": -haddock @@ -17,24 +15,28 @@ allow-newer-deps: - extensions - hw-fingertree - retrie + # stan dependencies + - directory-ospath-streaming extra-deps: - floskell-0.11.1 - - hiedb-0.6.0.2 + - hiedb-0.7.0.0 + - hie-compat-0.3.1.2 - implicit-hie-0.1.4.0 - - hie-bios-0.15.0 + - hie-bios-0.17.0 - hw-fingertree-0.1.2.1 - monad-dijkstra-0.1.1.5 - retrie-1.2.3 # stan dependencies not found in the stackage snapshot - - stan-0.1.3.0 + - stan-0.2.1.0 - dir-traverse-0.2.3.0 - extensions-0.1.0.1 - trial-0.0.0.0 - trial-optparse-applicative-0.0.0.0 - trial-tomland-0.0.0.0 - + - directory-ospath-streaming-0.2.2 + - cabal-add-0.2 configure-options: ghcide: - --disable-library-for-ghci @@ -48,8 +50,9 @@ flags: ghc-lib: true retrie: BuildExecutable: false - cabal-add: - cabal-syntax: true + # stan dependencies + directory-ospath-streaming: + os-string: false nix: packages: [icu libcxx zlib] diff --git a/test/functional/ConfigSchema.hs b/test/functional/ConfigSchema.hs index 3dbbe0ce2f..2ece6972e9 100644 --- a/test/functional/ConfigSchema.hs +++ b/test/functional/ConfigSchema.hs @@ -31,6 +31,9 @@ tests = testGroup "generate schema" , goldenGitDiff "generate-default-config" (defaultConfigFp ghcVersion) $ do stdout <- readProcess hlsExeCommand ["generate-default-config"] "" pure $ BS.pack stdout + , goldenGitDiff "plugins-custom-config-markdown-reference" (markdownReferenceFp ghcVersion) $ do + stdout <- readProcess hlsExeCommand ["plugins-custom-config-markdown-reference"] "" + pure $ BS.pack stdout ] vscodeSchemaFp :: GhcVersion -> FilePath @@ -39,11 +42,17 @@ vscodeSchemaFp ghcVer = "test" "testdata" "schema" prettyGhcVersion defaultConfigFp :: GhcVersion -> FilePath defaultConfigFp ghcVer = "test" "testdata" "schema" prettyGhcVersion ghcVer generateDefaultConfigJson +markdownReferenceFp :: GhcVersion -> FilePath +markdownReferenceFp ghcVer = "test" "testdata" "schema" prettyGhcVersion ghcVer markdownReferenceMd + vscodeSchemaJson :: FilePath vscodeSchemaJson = "vscode-extension-schema.golden.json" generateDefaultConfigJson :: FilePath generateDefaultConfigJson = "default-config.golden.json" +markdownReferenceMd :: FilePath +markdownReferenceMd = "markdown-reference.md" + prettyGhcVersion :: GhcVersion -> String prettyGhcVersion ghcVer = map toLower (show ghcVer) diff --git a/test/testdata/schema/ghc910/default-config.golden.json b/test/testdata/schema/ghc910/default-config.golden.json index 186a90aa3e..3b4e687ef9 100644 --- a/test/testdata/schema/ghc910/default-config.golden.json +++ b/test/testdata/schema/ghc910/default-config.golden.json @@ -91,6 +91,13 @@ }, "globalOn": true }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, "importLens": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc910/markdown-reference.md b/test/testdata/schema/ghc910/markdown-reference.md new file mode 100644 index 0000000000..668323ce66 --- /dev/null +++ b/test/testdata/schema/ghc910/markdown-reference.md @@ -0,0 +1,66 @@ +## hlint +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `flags` | Flags used by hlint | `TODO: Array values` |   | + +## cabal-fmt +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-fmt' executable | `"cabal-fmt"` |   | + +## ghcide-completions +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `autoExtendOn` | Extends the import list automatically when completing a out-of-scope identifier | `True` |   | +| `snippetsOn` | Inserts snippets when using code completions | `True` |   | + +## eval +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `exception` | Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi. | `False` |   | +| `diff` | Enable the diff output (WAS/NOW) of eval lenses | `True` |   | + +## ghcide-type-lenses +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `mode` | Control how type lenses are shown | `Always` |
  • Always
  • Exported
  • Diagnostics
| + +## ormolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "ormolu" executable, rather than using the bundled library | `False` |   | + +## rename +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `crossModule` | Enable experimental cross-module renaming | `False` |   | + +## semanticTokens +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `variableToken` | LSP semantic token type to use for variables | `SemanticTokenTypes_Variable` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `functionToken` | LSP semantic token type to use for functions | `SemanticTokenTypes_Function` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `dataConstructorToken` | LSP semantic token type to use for data constructors | `SemanticTokenTypes_EnumMember` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeVariableToken` | LSP semantic token type to use for type variables | `SemanticTokenTypes_TypeParameter` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classMethodToken` | LSP semantic token type to use for typeclass methods | `SemanticTokenTypes_Method` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `patternSynonymToken` | LSP semantic token type to use for pattern synonyms | `SemanticTokenTypes_Macro` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeConstructorToken` | LSP semantic token type to use for type constructors | `SemanticTokenTypes_Enum` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classToken` | LSP semantic token type to use for typeclasses | `SemanticTokenTypes_Class` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeSynonymToken` | LSP semantic token type to use for type synonyms | `SemanticTokenTypes_Type` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeFamilyToken` | LSP semantic token type to use for type families | `SemanticTokenTypes_Interface` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `recordFieldToken` | LSP semantic token type to use for record fields | `SemanticTokenTypes_Property` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `operatorToken` | LSP semantic token type to use for operators | `SemanticTokenTypes_Operator` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `moduleToken` | LSP semantic token type to use for modules | `SemanticTokenTypes_Namespace` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| + +## fourmolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "fourmolu" executable, rather than using the bundled library. | `False` |   | +| `path` | Set path to executable (for "external" mode). | `"fourmolu"` |   | + +## cabal-gild +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-gild' executable | `"cabal-gild"` |   | + + diff --git a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json index 3220003494..4ca08f296c 100644 --- a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json @@ -213,6 +213,24 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.importLens.codeActionsOn": { "default": true, "description": "Enables importLens code actions", diff --git a/test/testdata/schema/ghc912/markdown-reference.md b/test/testdata/schema/ghc912/markdown-reference.md new file mode 100644 index 0000000000..668323ce66 --- /dev/null +++ b/test/testdata/schema/ghc912/markdown-reference.md @@ -0,0 +1,66 @@ +## hlint +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `flags` | Flags used by hlint | `TODO: Array values` |   | + +## cabal-fmt +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-fmt' executable | `"cabal-fmt"` |   | + +## ghcide-completions +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `autoExtendOn` | Extends the import list automatically when completing a out-of-scope identifier | `True` |   | +| `snippetsOn` | Inserts snippets when using code completions | `True` |   | + +## eval +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `exception` | Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi. | `False` |   | +| `diff` | Enable the diff output (WAS/NOW) of eval lenses | `True` |   | + +## ghcide-type-lenses +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `mode` | Control how type lenses are shown | `Always` |
  • Always
  • Exported
  • Diagnostics
| + +## ormolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "ormolu" executable, rather than using the bundled library | `False` |   | + +## rename +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `crossModule` | Enable experimental cross-module renaming | `False` |   | + +## semanticTokens +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `variableToken` | LSP semantic token type to use for variables | `SemanticTokenTypes_Variable` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `functionToken` | LSP semantic token type to use for functions | `SemanticTokenTypes_Function` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `dataConstructorToken` | LSP semantic token type to use for data constructors | `SemanticTokenTypes_EnumMember` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeVariableToken` | LSP semantic token type to use for type variables | `SemanticTokenTypes_TypeParameter` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classMethodToken` | LSP semantic token type to use for typeclass methods | `SemanticTokenTypes_Method` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `patternSynonymToken` | LSP semantic token type to use for pattern synonyms | `SemanticTokenTypes_Macro` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeConstructorToken` | LSP semantic token type to use for type constructors | `SemanticTokenTypes_Enum` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classToken` | LSP semantic token type to use for typeclasses | `SemanticTokenTypes_Class` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeSynonymToken` | LSP semantic token type to use for type synonyms | `SemanticTokenTypes_Type` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeFamilyToken` | LSP semantic token type to use for type families | `SemanticTokenTypes_Interface` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `recordFieldToken` | LSP semantic token type to use for record fields | `SemanticTokenTypes_Property` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `operatorToken` | LSP semantic token type to use for operators | `SemanticTokenTypes_Operator` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `moduleToken` | LSP semantic token type to use for modules | `SemanticTokenTypes_Namespace` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| + +## fourmolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "fourmolu" executable, rather than using the bundled library. | `False` |   | +| `path` | Set path to executable (for "external" mode). | `"fourmolu"` |   | + +## cabal-gild +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-gild' executable | `"cabal-gild"` |   | + + diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json deleted file mode 100644 index 8467b451f1..0000000000 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ /dev/null @@ -1,164 +0,0 @@ -{ - "cabalFormattingProvider": "cabal-gild", - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true, - "diagnosticsOn": true, - "hoverOn": true, - "symbolsOn": true - }, - "cabal-fmt": { - "config": { - "path": "cabal-fmt" - } - }, - "cabal-gild": { - "config": { - "path": "cabal-gild" - } - }, - "cabalHaskellIntegration": { - "globalOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "codeActionsOn": true, - "codeLensOn": true, - "config": { - "diff": true, - "exception": false - } - }, - "explicit-fields": { - "codeActionsOn": true, - "inlayHintsOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false, - "path": "fourmolu" - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true, - "inlayHintsOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "config": { - "classMethodToken": "method", - "classToken": "class", - "dataConstructorToken": "enumMember", - "functionToken": "function", - "moduleToken": "namespace", - "operatorToken": "operator", - "patternSynonymToken": "macro", - "recordFieldToken": "property", - "typeConstructorToken": "enum", - "typeFamilyToken": "interface", - "typeSynonymToken": "type", - "typeVariableToken": "typeParameter", - "variableToken": "variable" - }, - "globalOn": false - }, - "splice": { - "globalOn": true - }, - "stan": { - "globalOn": false - } - }, - "sessionLoading": "singleComponent" -} diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json deleted file mode 100644 index 1c0b19eb27..0000000000 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ /dev/null @@ -1,1058 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal-fmt.config.path": { - "default": "cabal-fmt", - "markdownDescription": "Set path to 'cabal-fmt' executable", - "scope": "resource", - "type": "string" - }, - "haskell.plugin.cabal-gild.config.path": { - "default": "cabal-gild", - "markdownDescription": "Set path to 'cabal-gild' executable", - "scope": "resource", - "type": "string" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.diagnosticsOn": { - "default": true, - "description": "Enables cabal diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.hoverOn": { - "default": true, - "description": "Enables cabal hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.symbolsOn": { - "default": true, - "description": "Enables cabal symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabalHaskellIntegration.globalOn": { - "default": true, - "description": "Enables cabalHaskellIntegration plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.codeActionsOn": { - "default": true, - "description": "Enables eval code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.codeLensOn": { - "default": true, - "description": "Enables eval code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.codeActionsOn": { - "default": true, - "description": "Enables explicit-fields code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.inlayHintsOn": { - "default": true, - "description": "Enables explicit-fields inlay hints", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.path": { - "default": "fourmolu", - "markdownDescription": "Set path to executable (for \"external\" mode).", - "scope": "resource", - "type": "string" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.inlayHintsOn": { - "default": true, - "description": "Enables importLens inlay hints", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.classMethodToken": { - "default": "method", - "description": "LSP semantic token type to use for typeclass methods", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.classToken": { - "default": "class", - "description": "LSP semantic token type to use for typeclasses", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.dataConstructorToken": { - "default": "enumMember", - "description": "LSP semantic token type to use for data constructors", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.functionToken": { - "default": "function", - "description": "LSP semantic token type to use for functions", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.moduleToken": { - "default": "namespace", - "description": "LSP semantic token type to use for modules", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.operatorToken": { - "default": "operator", - "description": "LSP semantic token type to use for operators", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.patternSynonymToken": { - "default": "macro", - "description": "LSP semantic token type to use for pattern synonyms", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.recordFieldToken": { - "default": "property", - "description": "LSP semantic token type to use for record fields", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.typeConstructorToken": { - "default": "enum", - "description": "LSP semantic token type to use for type constructors", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.typeFamilyToken": { - "default": "interface", - "description": "LSP semantic token type to use for type families", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.typeSynonymToken": { - "default": "type", - "description": "LSP semantic token type to use for type synonyms", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.typeVariableToken": { - "default": "typeParameter", - "description": "LSP semantic token type to use for type variables", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.config.variableToken": { - "default": "variable", - "description": "LSP semantic token type to use for variables", - "enum": [ - "namespace", - "type", - "class", - "enum", - "interface", - "struct", - "typeParameter", - "parameter", - "variable", - "property", - "enumMember", - "event", - "function", - "method", - "macro", - "keyword", - "modifier", - "comment", - "string", - "number", - "regexp", - "operator", - "decorator" - ], - "enumDescriptions": [ - "LSP Semantic Token Type: namespace", - "LSP Semantic Token Type: type", - "LSP Semantic Token Type: class", - "LSP Semantic Token Type: enum", - "LSP Semantic Token Type: interface", - "LSP Semantic Token Type: struct", - "LSP Semantic Token Type: typeParameter", - "LSP Semantic Token Type: parameter", - "LSP Semantic Token Type: variable", - "LSP Semantic Token Type: property", - "LSP Semantic Token Type: enumMember", - "LSP Semantic Token Type: event", - "LSP Semantic Token Type: function", - "LSP Semantic Token Type: method", - "LSP Semantic Token Type: macro", - "LSP Semantic Token Type: keyword", - "LSP Semantic Token Type: modifier", - "LSP Semantic Token Type: comment", - "LSP Semantic Token Type: string", - "LSP Semantic Token Type: number", - "LSP Semantic Token Type: regexp", - "LSP Semantic Token Type: operator", - "LSP Semantic Token Type: decorator" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc96/markdown-reference.md b/test/testdata/schema/ghc96/markdown-reference.md new file mode 100644 index 0000000000..668323ce66 --- /dev/null +++ b/test/testdata/schema/ghc96/markdown-reference.md @@ -0,0 +1,66 @@ +## hlint +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `flags` | Flags used by hlint | `TODO: Array values` |   | + +## cabal-fmt +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-fmt' executable | `"cabal-fmt"` |   | + +## ghcide-completions +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `autoExtendOn` | Extends the import list automatically when completing a out-of-scope identifier | `True` |   | +| `snippetsOn` | Inserts snippets when using code completions | `True` |   | + +## eval +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `exception` | Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi. | `False` |   | +| `diff` | Enable the diff output (WAS/NOW) of eval lenses | `True` |   | + +## ghcide-type-lenses +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `mode` | Control how type lenses are shown | `Always` |
  • Always
  • Exported
  • Diagnostics
| + +## ormolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "ormolu" executable, rather than using the bundled library | `False` |   | + +## rename +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `crossModule` | Enable experimental cross-module renaming | `False` |   | + +## semanticTokens +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `variableToken` | LSP semantic token type to use for variables | `SemanticTokenTypes_Variable` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `functionToken` | LSP semantic token type to use for functions | `SemanticTokenTypes_Function` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `dataConstructorToken` | LSP semantic token type to use for data constructors | `SemanticTokenTypes_EnumMember` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeVariableToken` | LSP semantic token type to use for type variables | `SemanticTokenTypes_TypeParameter` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classMethodToken` | LSP semantic token type to use for typeclass methods | `SemanticTokenTypes_Method` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `patternSynonymToken` | LSP semantic token type to use for pattern synonyms | `SemanticTokenTypes_Macro` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeConstructorToken` | LSP semantic token type to use for type constructors | `SemanticTokenTypes_Enum` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classToken` | LSP semantic token type to use for typeclasses | `SemanticTokenTypes_Class` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeSynonymToken` | LSP semantic token type to use for type synonyms | `SemanticTokenTypes_Type` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeFamilyToken` | LSP semantic token type to use for type families | `SemanticTokenTypes_Interface` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `recordFieldToken` | LSP semantic token type to use for record fields | `SemanticTokenTypes_Property` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `operatorToken` | LSP semantic token type to use for operators | `SemanticTokenTypes_Operator` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `moduleToken` | LSP semantic token type to use for modules | `SemanticTokenTypes_Namespace` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| + +## fourmolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "fourmolu" executable, rather than using the bundled library. | `False` |   | +| `path` | Set path to executable (for "external" mode). | `"fourmolu"` |   | + +## cabal-gild +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-gild' executable | `"cabal-gild"` |   | + + diff --git a/test/testdata/schema/ghc98/markdown-reference.md b/test/testdata/schema/ghc98/markdown-reference.md new file mode 100644 index 0000000000..668323ce66 --- /dev/null +++ b/test/testdata/schema/ghc98/markdown-reference.md @@ -0,0 +1,66 @@ +## hlint +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `flags` | Flags used by hlint | `TODO: Array values` |   | + +## cabal-fmt +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-fmt' executable | `"cabal-fmt"` |   | + +## ghcide-completions +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `autoExtendOn` | Extends the import list automatically when completing a out-of-scope identifier | `True` |   | +| `snippetsOn` | Inserts snippets when using code completions | `True` |   | + +## eval +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `exception` | Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi. | `False` |   | +| `diff` | Enable the diff output (WAS/NOW) of eval lenses | `True` |   | + +## ghcide-type-lenses +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `mode` | Control how type lenses are shown | `Always` |
  • Always
  • Exported
  • Diagnostics
| + +## ormolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "ormolu" executable, rather than using the bundled library | `False` |   | + +## rename +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `crossModule` | Enable experimental cross-module renaming | `False` |   | + +## semanticTokens +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `variableToken` | LSP semantic token type to use for variables | `SemanticTokenTypes_Variable` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `functionToken` | LSP semantic token type to use for functions | `SemanticTokenTypes_Function` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `dataConstructorToken` | LSP semantic token type to use for data constructors | `SemanticTokenTypes_EnumMember` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeVariableToken` | LSP semantic token type to use for type variables | `SemanticTokenTypes_TypeParameter` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classMethodToken` | LSP semantic token type to use for typeclass methods | `SemanticTokenTypes_Method` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `patternSynonymToken` | LSP semantic token type to use for pattern synonyms | `SemanticTokenTypes_Macro` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeConstructorToken` | LSP semantic token type to use for type constructors | `SemanticTokenTypes_Enum` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `classToken` | LSP semantic token type to use for typeclasses | `SemanticTokenTypes_Class` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeSynonymToken` | LSP semantic token type to use for type synonyms | `SemanticTokenTypes_Type` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `typeFamilyToken` | LSP semantic token type to use for type families | `SemanticTokenTypes_Interface` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `recordFieldToken` | LSP semantic token type to use for record fields | `SemanticTokenTypes_Property` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `operatorToken` | LSP semantic token type to use for operators | `SemanticTokenTypes_Operator` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| +| `moduleToken` | LSP semantic token type to use for modules | `SemanticTokenTypes_Namespace` |
  • SemanticTokenTypes_Namespace
  • SemanticTokenTypes_Type
  • SemanticTokenTypes_Class
  • SemanticTokenTypes_Enum
  • SemanticTokenTypes_Interface
  • SemanticTokenTypes_Struct
  • SemanticTokenTypes_TypeParameter
  • SemanticTokenTypes_Parameter
  • SemanticTokenTypes_Variable
  • SemanticTokenTypes_Property
  • SemanticTokenTypes_EnumMember
  • SemanticTokenTypes_Event
  • SemanticTokenTypes_Function
  • SemanticTokenTypes_Method
  • SemanticTokenTypes_Macro
  • SemanticTokenTypes_Keyword
  • SemanticTokenTypes_Modifier
  • SemanticTokenTypes_Comment
  • SemanticTokenTypes_String
  • SemanticTokenTypes_Number
  • SemanticTokenTypes_Regexp
  • SemanticTokenTypes_Operator
  • SemanticTokenTypes_Decorator
| + +## fourmolu +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `external` | Call out to an external "fourmolu" executable, rather than using the bundled library. | `False` |   | +| `path` | Set path to executable (for "external" mode). | `"fourmolu"` |   | + +## cabal-gild +| Property | Description | Default | Allowed values | +| --- | --- | --- | --- | +| `path` | Set path to 'cabal-gild' executable | `"cabal-gild"` |   | + +