diff --git a/.azure/linux-installhs-stack.yml b/.azure/linux-installhs-stack.yml index 40bdc6424..086354113 100644 --- a/.azure/linux-installhs-stack.yml +++ b/.azure/linux-installhs-stack.yml @@ -29,4 +29,12 @@ jobs: - bash: | source .azure/linux.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` diff --git a/.azure/linux-stack.yml b/.azure/linux-stack.yml index 1e1270b34..806ee2846 100644 --- a/.azure/linux-stack.yml +++ b/.azure/linux-stack.yml @@ -23,8 +23,6 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: STACK_ROOT: /home/vsts/.stack steps: diff --git a/.azure/macos-installhs-stack.yml b/.azure/macos-installhs-stack.yml index 971b12a23..df7296193 100644 --- a/.azure/macos-installhs-stack.yml +++ b/.azure/macos-installhs-stack.yml @@ -29,4 +29,12 @@ jobs: - bash: | source .azure/macos.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/macos.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/macos.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` diff --git a/.azure/macos-stack.yml b/.azure/macos-stack.yml index 4a1097876..e7b72a93c 100644 --- a/.azure/macos-stack.yml +++ b/.azure/macos-stack.yml @@ -19,10 +19,8 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: - STACK_ROOT: /Users/vsts/.stack + STACK_ROOT: $(Build.SourcesDirectory)/.stack steps: - task: CacheBeta@0 inputs: diff --git a/.azure/windows-installhs-stack.yml b/.azure/windows-installhs-stack.yml index 3fab9d640..4dfed9e9d 100644 --- a/.azure/windows-installhs-stack.yml +++ b/.azure/windows-installhs-stack.yml @@ -27,4 +27,12 @@ jobs: - bash: | source .azure/windows.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/windows.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/windows.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` diff --git a/.azure/windows-stack.yml b/.azure/windows-stack.yml index 0cb58df94..68b2c4f0f 100644 --- a/.azure/windows-stack.yml +++ b/.azure/windows-stack.yml @@ -21,8 +21,6 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: STACK_ROOT: "C:\\sr" diff --git a/.circleci/config.yml b/.circleci/config.yml index ce13f428c..b97f446ac 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -101,21 +101,6 @@ defaults: &defaults version: 2 jobs: - ghc-8.0.2: - environment: - - STACK_FILE: "stack-8.0.2.yaml" - <<: *defaults - - ghc-8.2.1: - environment: - - STACK_FILE: "stack-8.2.1.yaml" - <<: *defaults - - ghc-8.2.2: - environment: - - STACK_FILE: "stack-8.2.2.yaml" - <<: *defaults - ghc-8.4.2: environment: - STACK_FILE: "stack-8.4.2.yaml" @@ -199,7 +184,6 @@ workflows: version: 2 multiple-ghcs: jobs: - - ghc-8.2.2 - ghc-8.4.2 - ghc-8.4.3 - ghc-8.4.4 diff --git a/.gitmodules b/.gitmodules index ae413540c..ef5db71b7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -12,7 +12,7 @@ [submodule "submodules/HaRe"] path = submodules/HaRe - url = https://github.com/wz1000/HaRe.git + url = https://github.com/alanz/HaRe.git [submodule "submodules/cabal-helper"] path = submodules/cabal-helper diff --git a/README.md b/README.md index c545ec174..34b278dec 100644 --- a/README.md +++ b/README.md @@ -178,7 +178,7 @@ sudo dnf install libicu-devel ncurses-devel In order to avoid problems with long paths on Windows you can do the following: -1. Edit the group policy: set "Enable Win32 long paths" to "Enabled" (Works +1. In the `Local Group Policy Editor`: `Local Computer Policy -> Computer Configuration -> Administrative Templates -> System -> Filesystem` set `Enable Win32 long paths` to `Enabled` (Works only for Windows 10). 2. Clone the `haskell-ide-engine` to the root of your logical drive (e.g. to @@ -216,7 +216,7 @@ cabal v2-run ./install.hs --project-file install/shake.project Running the script with cabal on windows requires a cabal version greater or equal to `3.0.0.0`. -Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. +Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. There are plans to remove this requirement and let users build hie only with one build tool or another. For brevity, only the `stack`-based commands are presented in the following sections. @@ -246,13 +246,12 @@ stack ./install.hs hie-8.4.4 stack ./install.hs build-data ``` -The Haskell IDE Engine can also be built with `cabal new-build` instead of `stack build`. +The Haskell IDE Engine can also be built with `cabal v2-build` instead of `stack build`. This has the advantage that you can decide how the GHC versions have been installed. -However, this approach does currently not work for windows due to a missing feature upstream. To see what GHC versions are available, the command `stack install.hs cabal-ghcs` can be used. It will list all GHC versions that are on the path and their respective installation directory. If you think, this list is incomplete, you can try to modify the PATH variable, such that the executables can be found. -Note, that the targets `cabal-build`, `cabal-build-data` and `cabal-build-all` depend on the found GHC versions. +Note, that the targets `cabal-build` and `cabal-build-data` depend on the found GHC versions. They install Haskell IDE Engine only for the found GHC versions. An example output is: @@ -274,12 +273,6 @@ stack install.hs cabal-hie-8.4.4 stack install.hs cabal-build-data ``` -To install HIE for all GHC versions that are present on your system, use: - -```bash -stack ./install.hs cabal-build-all -``` - In general, targets that use `cabal` instead of `stack` are prefixed with `cabal-*` and are identical to their counterpart, except they do not install a GHC if it is missing but fail. ##### Multiple versions of HIE (optional) @@ -503,7 +496,7 @@ Then issue `:CocConfig` and add the following to your Coc config file. "initializationOptions": { "languageServerHaskell": { } - }, + } } } ``` @@ -800,12 +793,32 @@ If you think `haskell-ide-engine` is using a lot of memory then the most useful thing you can do is prepare a profile of the memory usage whilst you're using the program. -1. Add `profiling: True` to the cabal.project file of `haskell-ide-engine +1. Add `profiling: True` to the cabal.project file of `haskell-ide-engine` 2. `cabal new-build hie` 3. (IMPORTANT) Add `profiling: True` to the `cabal.project` file of the project you want to profile. 4. Make a wrapper script which calls the `hie` you built in step 2 with the additional options `+RTS -hd -l-au` 5. Modify your editor settings to call this wrapper script instead of looking for `hie` on the path -6. Try using `h-i-e` as normal and then process the `*.eventlog` which will be created using `eventlog2html`. +6. Try using `h-i-e` as normal and then process the `*.eventlog` which will be created using [`eventlog2html`](http://hackage.haskell.org/package/eventlog2html). 7. Repeat the process again using different profiling options if you like. +#### Using `ghc-events-analyze` + +`haskell-ide-engine` contains the necessary tracing functions to work with [`ghc-events-analyze`](http://www.well-typed.com/blog/2014/02/ghc-events-analyze/). Each +request which is made will emit an event to the eventlog when it starts and finishes. This way you +can see if there are any requests which are taking a long time to complete or are blocking. + +1. Make sure that `hie` is linked with the `-eventlog` option. This can be achieved by adding the flag +to the `ghc-options` field in the cabal file. +2. Run `hie` as normal but with the addition of `+RTS -l`. This will produce an eventlog called `hie.eventlog`. +3. Run `ghc-events-analyze` on the `hie.eventlog` file to produce the rendered SVG. Warning, this might take a while and produce a big SVG file. + +The default options for `ghc-events-analyze` will produce quite a wide chart which is difficult to view. You can try using less buckets in order +to make the chart quicker to generate and faster to render. + +``` +ghc-events-analyze hie.eventlog -b 100 +``` + +This support is similar to the logging capabilities [built into GHC](https://www.haskell.org/ghc/blog/20190924-eventful-ghc.html). + diff --git a/appveyor.yml b/appveyor.yml index 88165d419..e45e2ca10 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -7,7 +7,6 @@ environment: - GHCVER: 8.4.4 - GHCVER: 8.4.3 - GHCVER: 8.4.2 - - GHCVER: 8.2.2 install: - cmd: >- git submodule update --init --recursive diff --git a/docs/Build.md b/docs/Build.md index 83c6afcbc..06f7a8190 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -13,7 +13,6 @@ The design of the build system has the following main goals: - `stack` - `git` * is completely functional right after a simple `git clone` and after every `git pull` -* one-stop-shop for building and naming all executables required for using `hie` in IDEs. * prevents certain build failures by either identifying a failed precondition (such as wrong `stack` version) or by performing the necessary steps so users can't forget them (such as invoking `git` to update submodules) @@ -28,8 +27,9 @@ See the project's `README` for detailed information about installing `hie`. The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly: * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. -* `build`: builds and installs `hie` binaries for all supported `ghc` versions. +* `build-latest`: builds and installs `hie` for the latest available and supported `ghc` version. * `build-data`: builds the hoogle-db required by `hie` +* `build`: builds and installs `hie` for the latest supported `ghc` version (like `build-latest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary. @@ -38,7 +38,7 @@ Each `stack-*.yaml` contains references to packages in the submodules. Calling ` `hie` depends on a correct environment in order to function properly: -* `cabal-install`: If no `cabal` executable can be found or has an outdated version, `cabal-install` is installed via `stack`. +* `cabal-install`: This dependency is required by `hie` to handle correctly projects that are not `stack` based (without `stack.yaml`). You can install an appropiate version using `stack` with the `stack-install-cabal` target. * The `hoogle` database: `hoogle generate` needs to be called with the most-recent `hoogle` version. ### Steps to build `hie` @@ -47,16 +47,15 @@ Installing `hie` is a multi-step process: 1. `git submodule sync && git submodule update --init` 2. `hoogle generate` (`hoogle>=5.0.17` to be safe) -3. ensure that `cabal-install` is installed in the correct version -4. `stack --stack-yaml=stack-.yaml install` or `cabal new-install -w ghc-` -5. rename `hie` binary to `hie-` in `$HOME/.local/bin`, where `` is the GHC version used -6. repeat step 4 and 5 for all desired GHC versions +3. `stack --stack-yaml=stack-.yaml install` or `cabal v2-install -w ghc-` +4. rename `hie` binary to `hie-` in `$HOME/.local/bin`, where `` is the GHC version used +5. repeat step 3 and 4 for all desired GHC versions This ensures that a complete install is always possible after each `git pull` or a `git clone`. #### Building `hie` with profiling support -To build `hie` with profiling enabled `cabal new-install` needs to be used instead of `stack`. +To build `hie` with profiling enabled `cabal v2-install` needs to be used instead of `stack`. Configure `cabal` to enable profiling by setting `profiling: True` in `cabal.project.local` for all packages. If that file does not already exist, create it as follows: @@ -71,7 +70,7 @@ Then `hie` can be compiled for a specific GHC version: ```bash export GHCP= -cabal new-install exe:hie -w $GHCP \ +cabal v2-install exe:hie -w $GHCP \ --write-ghc-environment-files=never --symlink-bindir=$HOME/.local/bin \ --overwrite-policy=always --reinstall ``` @@ -90,19 +89,17 @@ The final step is to configure the `hie` client to use a custom `hie-wrapper` sc The `install.hs` script performs some checks to ensure that a correct installation is possible and provide meaningful error messages for known issues. * `stack` needs to be up-to-date. Version `1.9.3` is required +* `cabal` needs to be up-to-date. Version `2.4.1.0` is required to *use* haskell-ide-engine until the pull request #1126 is merged. Unfortunately cabal version `3.0.0.0` is needed to *install* hie in windows systems but that inconsistence will be fixed by the mentioned pull request. * `ghc-8.6.3` is broken on windows. Trying to install `hie-8.6.3` on windows is not possible. -* `cabal new-build` does not work on windows at the moment. All `cabal-*` targets exit with an error message about that. * When the build fails, an error message, that suggests to remove `.stack-work` directory, is displayed. ### Tradeoffs #### `stack` is a build dependency -Currently, it is not possible to build all `hie-*` executables automatically without `stack`, since the `install.hs` script is executed by `stack`. +Currently, `stack` is needed even if you run the script with `cabal` to get the path where install the binaries but there are plans to remove that dependency (see #1380). -We are open to suggestions of other build systems that honor the requirements above, but are executable without `stack`. - -#### `install.hs` installs a GHC before running +#### run `install.hs` with `stack` installs a GHC before running Before the code in `install.hs` can be executed, `stack` installs a `GHC`, depending on the `resolver` field in `shake.yaml`. This is necessary if `install.hs` should be completely functional right after a fresh `git clone` without further configuration. diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index ad865a780..540fe3ad4 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -1,5 +1,5 @@ name: haskell-ide-engine -version: 0.13.0.0 +version: 1.0.0.0 synopsis: Provide a common engine to power any Haskell IDE description: Please see README.md homepage: http://github.com/githubuser/haskell-ide-engine#readme @@ -69,8 +69,8 @@ library , gitrev >= 1.1 , haddock-api , haddock-library - , haskell-lsp == 0.17.* - , haskell-lsp-types == 0.17.* + , haskell-lsp == 0.18.* + , haskell-lsp-types == 0.18.* , haskell-src-exts , hie-plugin-api , hoogle >= 5.0.13 @@ -98,10 +98,7 @@ library , hie-bios , bytestring-trie , unliftio - if impl(ghc < 8.4) - build-depends: hlint >= 2.0.11 && < 2.1.18 - else - build-depends: hlint >= 2.2.2 + , hlint >= 2.2.2 ghc-options: -Wall -Wredundant-constraints if flag(pedantic) @@ -203,11 +200,12 @@ test-suite unit-test , free , ghc , haskell-ide-engine - , haskell-lsp-types == 0.17.* + , haskell-lsp-types == 0.18.* , hie-test-utils , hie-plugin-api , hoogle > 5.0.11 , hspec + , process , quickcheck-instances , text , unordered-containers @@ -292,8 +290,8 @@ test-suite func-test , filepath , lsp-test >= 0.8.0.0 , haskell-ide-engine - , haskell-lsp-types == 0.17.* - , haskell-lsp == 0.17.* + , haskell-lsp-types == 0.18.* + , haskell-lsp == 0.18.* , hie-test-utils , hie-plugin-api , hspec diff --git a/hie-plugin-api/Haskell/Ide/Engine/Compat.hs b/hie-plugin-api/Haskell/Ide/Engine/Compat.hs index fb172f72d..0f7d5322f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Compat.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Compat.hs @@ -37,18 +37,12 @@ isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions #endif -#if MIN_VERSION_ghc(8, 4, 0) type GhcTc = GHC.GhcTc -#else -type GhcTc = GHC.Id -#endif pattern HsOverLitType :: Type.Type -> GHC.HsExpr GhcTc pattern HsOverLitType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsOverLit _ (GHC.overLitType -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsOverLit (GHC.overLitType -> t) #else GHC.HsOverLit (GHC.overLitType -> t) #endif @@ -57,8 +51,6 @@ pattern HsLitType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLitType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLit _ (TcHsSyn.hsLitType -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLit (TcHsSyn.hsLitType -> t) #else GHC.HsLit (TcHsSyn.hsLitType -> t) #endif @@ -67,8 +59,6 @@ pattern HsLamType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLamType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLam _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -77,8 +67,6 @@ pattern HsLamCaseType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLamCaseType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLamCase _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -87,8 +75,6 @@ pattern HsCaseType :: Type.Type -> GHC.HsExpr GhcTc pattern HsCaseType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsCase _ _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -97,8 +83,6 @@ pattern ExplicitListType :: Type.Type -> GHC.HsExpr GhcTc pattern ExplicitListType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ #else GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ #endif @@ -107,8 +91,6 @@ pattern ExplicitSumType :: Type.Type -> GHC.HsExpr GhcTc pattern ExplicitSumType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.ExplicitSum (TysWiredIn.mkSumTy -> t) _ _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t) #else GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t) #endif @@ -118,8 +100,6 @@ pattern HsMultiIfType :: Type.Type -> GHC.HsExpr GhcTc pattern HsMultiIfType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsMultiIf t _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsMultiIf t _ #else GHC.HsMultiIf t _ #endif @@ -128,8 +108,6 @@ pattern FunBindType :: Type.Type -> GHC.HsBindLR GhcTc GhcTc pattern FunBindType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.FunBind _ (GHC.L _ (Var.varType -> t)) _ _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _ #else GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _ #endif @@ -138,8 +116,6 @@ pattern FunBindGen :: Type.Type -> GHC.MatchGroup GhcTc (GHC.LHsExpr GhcTc) -> G pattern FunBindGen t fmatches <- #if MIN_VERSION_ghc(8, 6, 0) GHC.FunBind _ (GHC.L _ (Var.varType -> t)) fmatches _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.FunBind (GHC.L _ (Var.varType -> t)) fmatches _ _ _ #else GHC.FunBind (GHC.L _ (Var.varType -> t)) fmatches _ _ _ #endif @@ -148,10 +124,8 @@ pattern AbsBinds :: GHC.LHsBinds GhcTc -> GHC.HsBindLR GhcTc GhcTc pattern AbsBinds bs <- #if MIN_VERSION_ghc(8, 6, 0) GHC.AbsBinds _ _ _ _ _ bs _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.AbsBinds _ _ _ _ bs _ #else - GHC.AbsBinds _ _ _ _ bs + GHC.AbsBinds _ _ _ _ bs _ #endif #if MIN_VERSION_ghc(8, 6, 0) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index fc55f0f20..97488b52f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -16,6 +16,8 @@ module Haskell.Ide.Engine.Ghc , makeRevRedirMapFunc ) where +import Debug.Trace + import Bag import Control.Monad.IO.Class import Control.Monad ( when ) @@ -174,18 +176,28 @@ logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics - logDiag rfm eref dref df reason sev spn style msg = do eloc <- srcSpan2Loc rfm spn debugm $ "Diagnostics at Location: " <> show (spn, eloc) - let msgTxt = T.pack $ renderWithStyle df msg style - case eloc of - Right (Location uri range) -> do - let update = Map.insertWith Set.union (toNormalizedUri uri) l - where l = Set.singleton diag - diag = Diagnostic range (Just $ lspSev reason sev) Nothing (Just "bios") msgTxt Nothing - debugm $ "Writing diag " <> (show diag) - modifyIORef' dref (\(Diagnostics u) -> Diagnostics (update u)) - Left _ -> do - debugm $ "Writing err " <> (show msgTxt) - modifyIORef' eref (msgTxt:) - return () + let msgString = renderWithStyle df msg style + msgTxt = T.pack msgString + case sev of + -- These three verbosity levels are triggered by increasing verbosity. + -- Normally the verbosity is set to 0 when the session is initialised but + -- sometimes for debugging it is useful to override this and piping the messages + -- to the normal debugging framework means they just show up in the normal log. + SevOutput -> debugm msgString + SevDump -> debugm msgString + SevInfo -> debugm msgString + _ -> do + case eloc of + Right (Location uri range) -> do + let update = Map.insertWith Set.union (toNormalizedUri uri) l + where l = Set.singleton diag + diag = Diagnostic range (Just $ lspSev reason sev) Nothing (Just "bios") msgTxt Nothing + debugm $ "Writing diag " <> (show diag) + modifyIORef' dref (\(Diagnostics u) -> Diagnostics (update u)) + Left _ -> do + debugm $ "Writing err " <> (show msgTxt) + modifyIORef' eref (msgTxt:) + return () errorHandlers :: (String -> m a) -> (HscTypes.SourceError -> m a) -> [ErrorHandler m a] @@ -212,13 +224,14 @@ errorHandlers ghcErrRes renderSourceError = handlers -- | Load a module from a filepath into the cache, first check the cache -- to see if it's already there. setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs)) -setTypecheckedModule uri = +setTypecheckedModule uri = do + liftIO $ traceEventIO ("START typecheck" ++ show uri) pluginGetFile "setTypecheckedModule: " uri $ \_fp -> do debugm "setTypecheckedModule: before ghc-mod" debugm "Loading file" - -- mapped_fp <- persistVirtualFile uri - -- ifCachedModuleM mapped_fp (setTypecheckedModule_load uri) cont - setTypecheckedModule_load uri + res <- setTypecheckedModule_load uri + liftIO $ traceEventIO ("STOP typecheck" ++ show uri) + return res -- Hacky, need to copy hs-boot file if one exists for a module -- This is because the virtual file gets created at VFS-1234.hs and diff --git a/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs index d10453038..493b2ef01 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs @@ -1,7 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TupleSections #-} module Haskell.Ide.Engine.GhcModuleCache where @@ -79,9 +78,9 @@ getThingsAtPos cm pos ts = -- --------------------------------------------------------------------- -- The following to move into ghc-mod-core -class (Monad m) => HasGhcModuleCache m where +class Monad m => HasGhcModuleCache m where getModuleCache :: m GhcModuleCache - setModuleCache :: GhcModuleCache -> m () + modifyModuleCache :: (GhcModuleCache -> GhcModuleCache) -> m () emptyModuleCache :: GhcModuleCache emptyModuleCache = GhcModuleCache T.empty Map.empty Nothing diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs index 4a080723c..4cb3e3a86 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs @@ -66,9 +66,7 @@ import Haskell.Ide.Engine.MonadFunctions -- --------------------------------------------------------------------- modifyCache :: (HasGhcModuleCache m) => (GhcModuleCache -> GhcModuleCache) -> m () -modifyCache f = do - mc <- getModuleCache - setModuleCache (f mc) +modifyCache f = modifyModuleCache f -- --------------------------------------------------------------------- -- | Run the given action in context and initialise a session with hie-bios. @@ -422,7 +420,9 @@ failModule fp = do runDeferredActions :: FilePath -> UriCacheResult -> IdeGhcM () runDeferredActions uri res = do - actions <- fmap (fromMaybe [] . Map.lookup uri) (requestQueue <$> readMTS) + -- In general it is unsafe to read and then modify but the modification doesn't + -- capture the previously read state. + actions <- fromMaybe [] . Map.lookup uri . requestQueue <$> readMTS -- remove queued actions modifyMTS $ \s -> s { requestQueue = Map.delete uri (requestQueue s) } diff --git a/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs b/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs index 28bba128a..0d59a6752 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs @@ -33,8 +33,6 @@ runMTState m s = do class MonadIO m => MonadMTState s m | m -> s where readMTS :: m s modifyMTS :: (s -> s) -> m () - writeMTS :: s -> m () - writeMTS s = modifyMTS (const s) instance MonadMTState s (MultiThreadState s) where readMTS = readMTState diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 501d04c5c..42282b911 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -279,7 +279,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text) readVFS uri = do mvf <- getVirtualFile uri case mvf of - Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt) + Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt) Nothing -> return Nothing getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index b46502454..09ab39a95 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveAnyClass #-} @@ -10,7 +9,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} @@ -346,7 +344,7 @@ getDiagnosticProvidersConfig c = Map.fromList [("applyrefact",hlintOn c) -- Monads -- --------------------------------------------------------------------- --- | IdeM that allows for interaction with the ghc-mod session +-- | IdeM that allows for interaction with the Ghc session type IdeGhcM = GhcT IdeM --instance GM.MonadIO (GhcT IdeM) where @@ -359,8 +357,7 @@ type IdeGhcM = GhcT IdeM runIdeGhcM :: IdePlugins -> Maybe (Core.LspFuncs Config) -> TVar IdeState -> IdeGhcM a -> IO a runIdeGhcM plugins mlf stateVar f = do env <- IdeEnv <$> pure mlf <*> getProcessID <*> pure plugins - eres <- flip runReaderT stateVar $ flip runReaderT env $ BIOS.withGhcT f - return eres + flip runReaderT stateVar $ flip runReaderT env $ BIOS.withGhcT f {- -- | Run an IdeGhcM in an external context (e.g. HaRe), with no plugins or LSP functions @@ -469,13 +466,7 @@ reverseFileMap = do -- but less likely to throw an error and rather give Nothing. getPersistedFile' :: Core.LspFuncs Config -> Uri -> IO (Maybe FilePath) getPersistedFile' lf uri = - Core.getVirtualFileFunc lf (toNormalizedUri uri) >>= \case - Just (VirtualFile _ _ (Just file)) -> do - return (Just file) - Just (VirtualFile _ _ Nothing) -> do - file <- persistVirtualFile' lf uri - return (Just file) - Nothing -> return Nothing + Just <$> persistVirtualFile' lf uri -- | Get the location of the virtual file persisted to the file system associated -- to the given Uri. @@ -577,20 +568,20 @@ instance LiftsToGhc IdeGhcM where instance HasGhcModuleCache IdeGhcM where getModuleCache = lift getModuleCache - setModuleCache = lift . setModuleCache + modifyModuleCache = lift . modifyModuleCache instance HasGhcModuleCache IdeDeferM where getModuleCache = lift getModuleCache - setModuleCache = lift . setModuleCache + modifyModuleCache = lift . modifyModuleCache instance HasGhcModuleCache IdeM where getModuleCache = do tvar <- lift ask state <- readTVarIO tvar return (moduleCache state) - setModuleCache !mc = do + modifyModuleCache f = do tvar <- lift ask - atomically $ modifyTVar' tvar (\st -> st { moduleCache = mc }) + atomically $ modifyTVar' tvar (\st -> st { moduleCache = f (moduleCache st) }) -- --------------------------------------------------------------------- diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 01a716183..ce45e1fa0 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -1,5 +1,5 @@ name: hie-plugin-api -version: 0.13.0.0 +version: 1.0.0.0 synopsis: Haskell IDE API for plugin communication license: BSD3 license-file: LICENSE @@ -52,7 +52,7 @@ library , hie-bios , ghc-project-types >= 5.9.0.0 , cabal-helper - , haskell-lsp == 0.17.* + , haskell-lsp == 0.18.* , hslogger , unliftio , monad-control diff --git a/install.hs b/install.hs index b68745bd3..094ee774a 100755 --- a/install.hs +++ b/install.hs @@ -14,6 +14,7 @@ build-depends: -- * `stack install.hs ` -- TODO: set `shake.project` in cabal-config above, when supported +-- (see https://github.com/haskell/cabal/issues/6353) import HieInstall (defaultMain) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 0c0ca380d..25d1c0203 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -31,20 +31,29 @@ cabalBuildData = do execCabal_ ["v2-build", "hoogle"] execCabal_ ["v2-exec", "hoogle", "generate"] -cabalBuildHie :: VersionNumber -> Action () -cabalBuildHie versionNumber = do - ghcPath <- getGhcPathOf versionNumber >>= \case +getGhcPathOfOrThrowError :: VersionNumber -> Action GhcPath +getGhcPathOfOrThrowError versionNumber = + getGhcPathOf versionNumber >>= \case Nothing -> do printInStars $ ghcVersionNotFoundFailMsg versionNumber error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p + +cabalBuildHie :: VersionNumber -> Action () +cabalBuildHie versionNumber = do + ghcPath <- getGhcPathOfOrThrowError versionNumber execCabal_ - ["v2-build", "-w", ghcPath, "--write-ghc-environment-files=never", "--max-backjumps=5000", "--disable-tests"] + [ "v2-build" + , "-w", ghcPath + , "--write-ghc-environment-files=never" + , "--max-backjumps=5000" + , "--disable-tests"] cabalInstallHie :: VersionNumber -> Action () cabalInstallHie versionNumber = do localBin <- getLocalBin cabalVersion <- getCabalVersion + ghcPath <- getGhcPathOfOrThrowError versionNumber let isCabal3 = checkVersion [3,0,0,0] cabalVersion installDirOpt | isCabal3 = "--installdir" @@ -53,8 +62,9 @@ cabalInstallHie versionNumber = do | otherwise = [] execCabal_ $ [ "v2-install" + , "-w", ghcPath , "--write-ghc-environment-files=never" - , installDirOpt ++ "=" ++ localBin + , installDirOpt, localBin , "exe:hie" , "--overwrite-policy=always" ] diff --git a/install/src/Env.hs b/install/src/Env.hs index b7d232c37..cd8a296bd 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -8,7 +8,10 @@ import Development.Shake.FilePath import System.Info ( os , arch ) -import Data.Maybe ( isJust ) +import Data.Maybe ( isJust + , isNothing + , mapMaybe + ) import System.Directory ( findExecutable , findExecutables , listDirectory @@ -17,13 +20,13 @@ import Data.Function ( (&) , on ) import Data.List ( sort + , sortBy , isInfixOf , nubBy ) +import Data.Ord ( comparing ) import Control.Monad.Extra ( mapMaybeM ) -import Data.Maybe ( isNothing - , mapMaybe - ) + import qualified Data.Text as T import Version @@ -45,15 +48,18 @@ findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] knownGhcs <- mapMaybeM (\version -> getGhcPathOf version >>= \case - Nothing -> return Nothing - Just p -> return $ Just (version, p) + Nothing -> return Nothing + Just p -> return $ Just (version, p) ) (reverse hieVersions) - availableGhcs <- getGhcPaths + -- filter out not supported ghc versions + availableGhcs <- filter ((`elem` hieVersions) . fst) <$> getGhcPaths return + -- sort by version to make it coherent with getHieVersions + $ sortBy (comparing fst) -- nub by version. knownGhcs takes precedence. $ nubBy ((==) `on` fst) - -- filter out stack provided GHCs + -- filter out stack provided GHCs (assuming that stack programs path is the default one in linux) $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) -- | Get the path to a GHC that has the version specified by `VersionNumber` @@ -63,7 +69,7 @@ findInstalledGhcs = do -- command fits to the desired version. getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath) getGhcPathOf ghcVersion = - liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case + liftIO $ findExecutable ("ghc-" ++ ghcVersion <.> exe) >>= \case Nothing -> lookup ghcVersion <$> getGhcPaths path -> return path @@ -87,7 +93,6 @@ ghcVersionNotFoundFailMsg versionNumber = -- | Defines all different hie versions that are buildable. -- -- The current directory is scanned for `stack-*.yaml` files. --- On windows, `8.6.3` is excluded as this version of ghc does not work there getHieVersions :: MonadIO m => m [VersionNumber] getHieVersions = do let stackYamlPrefix = T.pack "stack-" diff --git a/install/src/Help.hs b/install/src/Help.hs index 7a8b347e6..02b529c8e 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -12,13 +12,23 @@ import Version import BuildSystem import Cabal +stackCommand :: TargetDescription -> String +stackCommand target = "stack install.hs " ++ fst target + +cabalCommand :: TargetDescription -> String +cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project " ++ fst target + +buildCommand :: TargetDescription -> String +buildCommand | isRunFromCabal = cabalCommand + | otherwise = stackCommand + printUsage :: Action () printUsage = do printLine "" printLine "Usage:" - printLineIndented "stack install.hs " + printLineIndented (stackCommand templateTarget) printLineIndented "or" - printLineIndented "cabal new-run install.hs --project-file install/shake.project " + printLineIndented (cabalCommand templateTarget) -- | short help message is printed by default shortHelpMessage :: Action () @@ -35,7 +45,7 @@ shortHelpMessage = do [ ("help", "Show help message including all targets") , emptyTarget , buildTarget - , buildAllTarget + , buildLatestTarget , hieTarget $ last hieVersions , buildDataTarget , cabalGhcsTarget @@ -76,12 +86,12 @@ helpMessage versions@BuildableVersions {..} = do -- All targets with their respective help message. generalTargets = [helpTarget] - defaultTargets = [buildTarget, buildAllTarget, buildDataTarget] + defaultTargets = [buildTarget, buildLatestTarget, buildDataTarget] ++ map hieTarget (getDefaultBuildSystemVersions versions) stackTargets = [ stackTarget buildTarget - , stackTarget buildAllTarget + , stackTarget buildLatestTarget , stackTarget buildDataTarget ] ++ (if isRunFromStack then [stackTarget installCabalTarget] else []) @@ -90,7 +100,7 @@ helpMessage versions@BuildableVersions {..} = do cabalTargets = [ cabalGhcsTarget , cabalTarget buildTarget - , cabalTarget buildAllTarget + , cabalTarget buildLatestTarget , cabalTarget buildDataTarget ] ++ map (cabalTarget . hieTarget) cabalVersions @@ -99,6 +109,9 @@ helpMessage versions@BuildableVersions {..} = do emptyTarget :: (String, String) emptyTarget = ("", "") +templateTarget :: (String, String) +templateTarget = ("", "") + targetWithBuildSystem :: String -> TargetDescription -> TargetDescription targetWithBuildSystem system (target, description) = (system ++ "-" ++ target, description ++ "; with " ++ system) @@ -114,17 +127,16 @@ hieTarget version = ("hie-" ++ version, "Builds hie for GHC version " ++ version) buildTarget :: TargetDescription -buildTarget = ("build", "Builds hie with all installed GHCs") +buildTarget = ("build", "Build hie with the latest available GHC and the data files") + +buildLatestTarget :: TargetDescription +buildLatestTarget = ("build-latest", "Build hie with the latest available GHC") buildDataTarget :: TargetDescription buildDataTarget = ("build-data", "Get the required data-files for `hie` (Hoogle DB)") -buildAllTarget :: TargetDescription -buildAllTarget = - ("build-all", "Builds hie for all installed GHC versions and the data files") - --- speical targets +-- special targets macosIcuTarget :: TargetDescription macosIcuTarget = ("icu-macos-fix", "Fixes icu related problems in MacOS") @@ -135,13 +147,15 @@ helpTarget = ("help", "Show help message including all targets") cabalGhcsTarget :: TargetDescription cabalGhcsTarget = ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + , "Show all GHC versions that can be installed via `cabal-build`." ) installCabalTarget :: TargetDescription installCabalTarget = ( "install-cabal" - , "Install the cabal executable. It will install the required minimum version for hie (currently " ++ versionToString requiredCabalVersion ++ ") if it isn't already present in $PATH" + , "Install the cabal executable. It will install the required minimum version for hie (currently " + ++ versionToString requiredCabalVersion + ++ ") if it isn't already present in $PATH" ) -- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index b05f1714d..f3e12e57b 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -57,6 +57,8 @@ defaultMain = do , cabalVersions = ghcVersions } + let latestVersion = last hieVersions + putStrLn $ "run from: " ++ buildSystem shakeArgs shakeOptions { shakeFiles = "_build" } $ do @@ -82,7 +84,7 @@ defaultMain = do -- default-targets phony "build" $ need [buildSystem ++ "-build"] - phony "build-all" $ need [buildSystem ++ "-build-all"] + phony "build-latest" $ need [buildSystem ++ "-build-latest"] phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ (getDefaultBuildSystemVersions versions) @@ -92,8 +94,9 @@ defaultMain = do -- stack specific targets when isRunFromStack (phony "stack-install-cabal" (need ["cabal"])) - phony "stack-build" (need (reverse $ map ("stack-hie-" ++) hieVersions)) - phony "stack-build-all" (need ["build-data", "build"]) + phony "stack-build-latest" (need ["stack-hie-" ++ last hieVersions]) + phony "stack-build" (need ["build-data", "stack-build-latest"]) + phony "stack-build-data" $ do need ["submodules"] need ["check-stack"] @@ -108,8 +111,8 @@ defaultMain = do ) -- cabal specific targets - phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-all" (need ["cabal-build-data", "cabal-build"]) + phony "cabal-build-latest" (need ["cabal-hie-" ++ last ghcVersions]) + phony "cabal-build" (need ["build-data", "cabal-build-latest"]) phony "cabal-build-data" $ do need ["submodules"] need ["cabal"] diff --git a/install/src/Print.hs b/install/src/Print.hs index 82904491f..41216022b 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -18,7 +18,7 @@ printLineIndented = printLine . (" " ++) embedInStars :: String -> String embedInStars str = - let starsLine = "\n" <> replicate 30 '*' <> "\n" + let starsLine = "\n" <> replicate 80 '*' <> "\n" in starsLine <> str <> starsLine printInStars :: MonadIO m => String -> m () diff --git a/install/src/Stack.hs b/install/src/Stack.hs index eef3126a6..dd054f93e 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -3,11 +3,13 @@ module Stack where import Development.Shake import Development.Shake.Command import Development.Shake.FilePath +import Control.Exception import Control.Monad import Data.List import System.Directory ( copyFile ) -import System.FilePath ( searchPathSeparator, () ) +import System.FilePath ( splitSearchPath, searchPathSeparator, () ) import System.Environment ( lookupEnv, setEnv, getEnvironment ) +import System.IO.Error ( isDoesNotExistError ) import BuildSystem import Version import Print @@ -102,6 +104,7 @@ stackBuildFailMsg = -- |Run actions without the stack cached binaries withoutStackCachedBinaries :: Action a -> Action a withoutStackCachedBinaries action = do + mbPath <- liftIO (lookupEnv "PATH") case (mbPath, isRunFromStack) of @@ -121,13 +124,7 @@ withoutStackCachedBinaries action = do otherwise -> action where removePathsContaining strs path = - joinPaths (filter (not . containsAny) (splitPaths path)) + joinPaths (filter (not . containsAny) (splitSearchPath path)) where containsAny p = any (`isInfixOf` p) strs - joinPaths = intercalate [searchPathSeparator] - - splitPaths s = - case dropWhile (== searchPathSeparator) s of - "" -> [] - s' -> w : words s'' - where (w, s'') = break (== searchPathSeparator) s' + joinPaths = intercalate [searchPathSeparator] \ No newline at end of file diff --git a/src/Haskell/Ide/Engine/LSP/CodeActions.hs b/src/Haskell/Ide/Engine/LSP/CodeActions.hs index 00b20c897..c0ac387c7 100644 --- a/src/Haskell/Ide/Engine/LSP/CodeActions.hs +++ b/src/Haskell/Ide/Engine/LSP/CodeActions.hs @@ -42,9 +42,9 @@ handleCodeActionReq tn req = do providersCb providers = let reqs = map (\f -> lift (f docId range context)) providers - in makeRequests reqs tn (req ^. J.id) (send . filter wasRequested . concat) + in makeRequests reqs "code-actions" tn (req ^. J.id) (send . filter wasRequested . concat) - makeRequest (IReq tn (req ^. J.id) providersCb getProviders) + makeRequest (IReq tn "code-actions" (req ^. J.id) providersCb getProviders) where params = req ^. J.params diff --git a/src/Haskell/Ide/Engine/LSP/Completions.hs b/src/Haskell/Ide/Engine/LSP/Completions.hs index ef50c8d8c..718aad554 100644 --- a/src/Haskell/Ide/Engine/LSP/Completions.hs +++ b/src/Haskell/Ide/Engine/LSP/Completions.hs @@ -42,6 +42,8 @@ import Packages (listVisibleModuleNames) import Language.Haskell.Refact.API ( showGhc ) import qualified Language.Haskell.LSP.Types as J +import qualified Language.Haskell.LSP.Types.Capabilities + as J import qualified Language.Haskell.LSP.Types.Lens as J import qualified Haskell.Ide.Engine.Support.Fuzzy @@ -92,8 +94,8 @@ instance FromJSON CompItemResolveData where instance ToJSON CompItemResolveData where toJSON = genericToJSON $ customOptions 0 -resolveCompletion :: J.CompletionItem -> IdeM J.CompletionItem -resolveCompletion origCompl = +resolveCompletion :: WithSnippets -> J.CompletionItem -> IdeM J.CompletionItem +resolveCompletion withSnippets origCompl = case fromJSON <$> origCompl ^. J.xdata of Just (J.Success compdata) -> do mdocs <- Hoogle.infoCmd' $ hoogleQuery compdata @@ -113,10 +115,11 @@ resolveCompletion origCompl = insertText = label <> " " <> getArgText typ det = Just . stripForall $ T.pack (showGhc typ) <> "\n" pure (det,Just insertText) - return $ origCompl & J.documentation .~ docs + let compl = origCompl & J.documentation .~ docs & J.insertText .~ insert & J.insertTextFormat ?~ J.Snippet & J.detail .~ (detail <> origCompl ^. J.detail) + toggleSnippets <$> getClientCapabilities <*> pure withSnippets <*> pure compl Just (J.Error err) -> do debugm $ "resolveCompletion: Decoding data failed because of: " ++ err pure origCompl @@ -293,26 +296,28 @@ instance ModuleCache CachedCompletions where newtype WithSnippets = WithSnippets Bool +toggleSnippets :: J.ClientCapabilities -> WithSnippets -> J.CompletionItem -> J.CompletionItem +toggleSnippets clientCaps (WithSnippets with) x + | with && supported = x + | otherwise = x { J._insertTextFormat = Just J.PlainText + , J._insertText = Nothing + } + where supported = fromMaybe False (clientCaps ^? J.textDocument + . _Just + . J.completion + . _Just + . J.completionItem + . _Just + . J.snippetSupport + . _Just) + -- | Returns the cached completions for the given module and position. getCompletions :: Uri -> VFS.PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem]) -getCompletions uri prefixInfo (WithSnippets withSnippets) = +getCompletions uri prefixInfo withSnippets = pluginGetFile "getCompletions: " uri $ \file -> do - let snippetLens = (^? J.textDocument - . _Just - . J.completion - . _Just - . J.completionItem - . _Just - . J.snippetSupport - . _Just) - supportsSnippets <- fromMaybe False . snippetLens <$> getClientCapabilities - let toggleSnippets x - | withSnippets && supportsSnippets = x - | otherwise = x { J._insertTextFormat = Just J.PlainText - , J._insertText = Nothing - } - - VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo + caps <- getClientCapabilities + + let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo debugm $ "got prefix" ++ show (prefixModule, prefixText) let enteredQual = if T.null prefixModule then "" else prefixModule <> "." fullPrefix = enteredQual <> prefixText @@ -378,7 +383,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = ] filtListWithSnippet f list suffix = - [ toggleSnippets (f label (snippet <> suffix)) + [ toggleSnippets caps withSnippets (f label (snippet <> suffix)) | (snippet, label) <- list , Fuzzy.test fullPrefix label ] @@ -403,7 +408,8 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = | "{-# " `T.isPrefixOf` fullLine = filtPragmaCompls (pragmaSuffix fullLine) | otherwise - = filtModNameCompls ++ map (toggleSnippets . mkCompl . stripAutoGenerated) filtCompls + = filtModNameCompls ++ map (toggleSnippets caps withSnippets + . mkCompl . stripAutoGenerated) filtCompls in return $ IdeResultOk result where diff --git a/src/Haskell/Ide/Engine/LSP/Reactor.hs b/src/Haskell/Ide/Engine/LSP/Reactor.hs index acdb382db..f1e8dfdaf 100644 --- a/src/Haskell/Ide/Engine/LSP/Reactor.hs +++ b/src/Haskell/Ide/Engine/LSP/Reactor.hs @@ -9,6 +9,7 @@ module Haskell.Ide.Engine.LSP.Reactor , makeRequest , makeRequests , updateDocumentRequest + , updateDocument , cancelRequest , asksLspFuncs , getClientConfig @@ -116,6 +117,11 @@ updateDocumentRequest :: (MonadIO m, MonadReader REnv m) => Uri -> Int -> PluginRequest R -> m () updateDocumentRequest = Scheduler.updateDocumentRequest +updateDocument :: (MonadIO m, MonadReader REnv m) => Uri -> Int -> m () +updateDocument uri ver = do + re <- scheduler <$> ask + liftIO $ Scheduler.updateDocument re uri ver + -- | Marks a s requests as cencelled by its LspId cancelRequest :: (MonadIO m, MonadReader REnv m) => J.LspId -> m () cancelRequest lid = @@ -124,15 +130,16 @@ cancelRequest lid = -- | Execute multiple ide requests sequentially makeRequests :: [IdeDeferM (IdeResult a)] -- ^ The requests to make + -> String -> TrackingNumber -> J.LspId -> ([a] -> R ()) -- ^ Callback with the request inputs and results -> R () makeRequests = go [] where - go acc [] _ _ callback = callback acc - go acc (x : xs) tn reqId callback = - let reqCallback result = go (acc ++ [result]) xs tn reqId callback - in makeRequest $ IReq tn reqId reqCallback x + go acc [] _ _ _ callback = callback acc + go acc (x : xs) d tn reqId callback = + let reqCallback result = go (acc ++ [result]) xs d tn reqId callback + in makeRequest $ IReq tn d reqId reqCallback x -- --------------------------------------------------------------------- diff --git a/src/Haskell/Ide/Engine/Options.hs b/src/Haskell/Ide/Engine/Options.hs index 9fe1bebb3..43ce563ba 100644 --- a/src/Haskell/Ide/Engine/Options.hs +++ b/src/Haskell/Ide/Engine/Options.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} module Haskell.Ide.Engine.Options where -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup hiding (option) -#endif import Options.Applicative.Simple data GlobalOpts = GlobalOpts diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs index 4b287d398..33fca9188 100644 --- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs +++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -26,11 +25,7 @@ import Haskell.Ide.Engine.PluginUtils import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Parser import Language.Haskell.Exts.Extension -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) import Language.Haskell.HLint4 as Hlint -#else -import Language.Haskell.HLint3 as Hlint -#endif import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Lens as LSP import Refact.Apply diff --git a/src/Haskell/Ide/Engine/Plugin/Base.hs b/src/Haskell/Ide/Engine/Plugin/Base.hs index 3a0053ecc..1a7564c0d 100644 --- a/src/Haskell/Ide/Engine/Plugin/Base.hs +++ b/src/Haskell/Ide/Engine/Plugin/Base.hs @@ -11,9 +11,6 @@ import Data.Aeson import Data.Foldable import qualified Data.Map as Map import Data.Maybe -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup -#endif import qualified Data.Text as T import qualified Data.Versions as V import Development.GitRev (gitCommitCount) diff --git a/src/Haskell/Ide/Engine/Plugin/Build.hs b/src/Haskell/Ide/Engine/Plugin/Build.hs deleted file mode 100644 index e69de29bb..000000000 diff --git a/src/Haskell/Ide/Engine/Plugin/Example2.hs b/src/Haskell/Ide/Engine/Plugin/Example2.hs index 2a663727c..82a1d6680 100644 --- a/src/Haskell/Ide/Engine/Plugin/Example2.hs +++ b/src/Haskell/Ide/Engine/Plugin/Example2.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -9,9 +8,6 @@ import Control.Lens import Control.Monad.IO.Class import Data.Aeson import qualified Data.HashMap.Strict as H -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Map as Map import qualified Data.Set as S import qualified Data.Text as T diff --git a/src/Haskell/Ide/Engine/Plugin/HaRe.hs b/src/Haskell/Ide/Engine/Plugin/HaRe.hs index def0f09e6..2f4a27996 100644 --- a/src/Haskell/Ide/Engine/Plugin/HaRe.hs +++ b/src/Haskell/Ide/Engine/Plugin/HaRe.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,9 +13,6 @@ import qualified Data.Aeson.Types as J import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import Data.Foldable -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import qualified Data.Text.IO as T import Exception diff --git a/src/Haskell/Ide/Engine/Plugin/Haddock.hs b/src/Haskell/Ide/Engine/Plugin/Haddock.hs index 94d478bfb..f3aa088c8 100644 --- a/src/Haskell/Ide/Engine/Plugin/Haddock.hs +++ b/src/Haskell/Ide/Engine/Plugin/Haddock.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -9,9 +8,6 @@ module Haskell.Ide.Engine.Plugin.Haddock where import Control.Monad.State import Data.Foldable import qualified Data.Map as Map -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import Data.IORef import Data.Function @@ -196,9 +192,7 @@ renderMarkDown = ["```\n"]) , markupHeader = \h -> T.replicate (headerLevel h) "#" <> " " <> headerTitle h <> "\n" -#if __GLASGOW_HASKELL__ >= 804 , markupTable = mempty -#endif } where surround c x = c <> T.replace c "" x <> c removeInner x = T.replace "```" "" $ T.replace "```haskell" "" x diff --git a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs index 9030105c6..595aceda6 100644 --- a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs +++ b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs @@ -1,6 +1,5 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Haskell.Ide.Engine.Plugin.Hoogle where @@ -11,9 +10,6 @@ import Control.Applicative (liftA2) import Data.Aeson import Data.Bifunctor import Data.Maybe -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import Data.List import Haskell.Ide.Engine.MonadTypes diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs index 712787a02..266931bd6 100644 --- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs +++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,9 +9,6 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Exception (bracket) -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import Data.Aeson import qualified Data.ByteString.Lazy as BS import qualified Data.Map as Map @@ -170,10 +166,19 @@ runLiquidHaskell fp = do cp = (shell cmd) { cwd = Just dir } -- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" mpp <- lookupEnv "GHC_PACKAGE_PATH" + mge <- lookupEnv "GHC_ENVIRONMENT" -- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]" + -- env <- getEnvironment + -- logm $ "runLiquidHaskell:env=[" ++ show env ++ "]" (ec,o,e) <- bracket - (unsetEnv "GHC_PACKAGE_PATH") - (\_ -> mapM_ (setEnv "GHC_PACKAGE_PATH") mpp) + (do + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "GHC_PACKAGE_PATH" + ) + (\_ -> do + mapM_ (setEnv "GHC_PACKAGE_PATH") mpp + mapM_ (setEnv "GHC_ENVIRONMENT" ) mge + ) (\_ -> readCreateProcessWithExitCode cp "") -- logm $ "runLiquidHaskell:v=" ++ show (ec,o,e) return $ Just (ec,[o,e]) diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs index 019efd522..c574bb4f0 100644 --- a/src/Haskell/Ide/Engine/Scheduler.hs +++ b/src/Haskell/Ide/Engine/Scheduler.hs @@ -5,6 +5,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE AllowAmbiguousTypes #-} module Haskell.Ide.Engine.Scheduler ( Scheduler , DocUpdate @@ -17,10 +18,12 @@ module Haskell.Ide.Engine.Scheduler , cancelRequest , makeRequest , updateDocumentRequest + , updateDocument ) where -import Control.Concurrent.Async ( race_ ) +import Control.Concurrent.Async +import GHC.Conc import qualified Control.Concurrent.STM as STM import Control.Monad.IO.Class ( liftIO , MonadIO @@ -46,6 +49,8 @@ import Haskell.Ide.Engine.Types import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes +import Debug.Trace + -- | A Scheduler is a coordinator between the two main processes the ide engine uses -- for responding to users requests. It accepts all of the requests and dispatches @@ -159,7 +164,12 @@ runScheduler Scheduler {..} errorHandler callbackHandler mlf = do ideDispatcher dEnv errorHandler callbackHandler ideChanOut - runGhcDisp `race_` runIdeDisp + withAsync runGhcDisp $ \a -> + withAsync runIdeDisp $ \b -> do + flip labelThread "ghc" $ asyncThreadId a + flip labelThread "ide" $ asyncThreadId b + waitEither_ a b + -- | Sends a request to the scheduler so that it can be dispatched to the handler @@ -173,20 +183,13 @@ sendRequest :: forall m . Scheduler m -- ^ The scheduler to send the request to. - -> Maybe DocUpdate - -- ^ If not Nothing, the version for the given document is updated before dispatching. - -> PluginRequest m + -> PluginRequest m -- ^ The request to dispatch. -> IO () -sendRequest Scheduler {..} docUpdate req = do +sendRequest Scheduler {..} req = do let (ghcChanIn, _) = ghcChan (ideChanIn, _) = ideChan - case docUpdate of - Nothing -> pure () - Just (uri, ver) -> - STM.atomically $ STM.modifyTVar' documentVersions (Map.insert uri ver) - case req of Right ghcRequest@GhcRequest { pinLspReqId = Nothing } -> Channel.writeChan ghcChanIn ghcRequest @@ -217,7 +220,7 @@ makeRequest -> m () makeRequest req = do env <- ask - liftIO $ sendRequest (getScheduler env) Nothing req + liftIO $ sendRequest (getScheduler env) req -- | Updates the version of a document and then sends the request to be processed -- asynchronously. @@ -229,7 +232,20 @@ updateDocumentRequest -> m () updateDocumentRequest uri ver req = do env <- ask - liftIO $ sendRequest (getScheduler env) (Just (uri, ver)) req + let sched = (getScheduler env) + liftIO $ do + updateDocument sched uri ver + sendRequest sched req + +-- | Updates the version of a document and then sends the request to be processed +-- asynchronously. +updateDocument + :: Scheduler a + -> Uri + -> Int + -> IO () +updateDocument sched uri ver = + STM.atomically $ STM.modifyTVar' (documentVersions sched) (Map.insert uri ver) ------------------------------------------------------------------------------- -- Dispatcher @@ -261,7 +277,8 @@ ideDispatcher ideDispatcher env errorHandler callbackHandler pin = forever $ do debugm "ideDispatcher: top of loop" - (IdeRequest tn lid callback action) <- liftIO $ Channel.readChan pin + (IdeRequest tn d lid callback action) <- liftIO $ Channel.readChan pin + liftIO $ traceEventIO $ "START " ++ show tn ++ "ide:" ++ d debugm $ "ideDispatcher: got request " ++ show tn @@ -276,6 +293,8 @@ ideDispatcher env errorHandler callbackHandler pin = IdeResultOk x -> callbackHandler callback x IdeResultFail (IdeError _ msg _) -> errorHandler (Just lid) J.InternalError msg + + liftIO $ traceEventIO $ "STOP " ++ show tn ++ "ide:" ++ d where queueDeferred (Defer fp cacheCb) = lift $ modifyMTState $ \s -> let oldQueue = requestQueue s @@ -302,9 +321,10 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler iniDynFlags <- getSessionDynFlags forever $ do debugm "ghcDispatcher: top of loop" - GhcRequest tn context mver mid callback def action <- liftIO + GhcRequest tn d context mver mid callback def action <- liftIO $ Channel.readChan pin debugm $ "ghcDispatcher:got request " ++ show tn ++ " with id: " ++ show mid + liftIO $ traceEventIO $ "START " ++ show tn ++ "ghc:" ++ d let runner :: a -> IdeGhcM a -> IdeGhcM (IdeResult a) @@ -347,6 +367,7 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler Just lid -> unlessCancelled env lid errorHandler $ do liftIO $ completedReq env lid runIfVersionMatch + liftIO $ traceEventIO $ "STOP " ++ show tn ++ "ghc:" ++ d -- | Runs the passed monad only if the request identified by the passed LspId -- has not already been cancelled. diff --git a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs index 2a007b17e..dd8db6154 100644 --- a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -21,9 +20,6 @@ import Control.Monad.IO.Class import qualified Data.Aeson as J import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy.Char8 as B -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import GHC.Generics import Haskell.Ide.Engine.PluginsIdeMonads @@ -99,11 +95,11 @@ run scheduler = flip E.catches handlers $ do case mreq of Nothing -> return() Just req -> do - let preq = GReq 0 (context req) Nothing (Just $ J.IdInt rid) (liftIO . callback) (toDynJSON (Nothing :: Maybe ())) + let preq = GReq 0 "" (context req) Nothing (Just $ J.IdInt rid) (liftIO . callback) (toDynJSON (Nothing :: Maybe ())) $ runPluginCommand (plugin req) (command req) (arg req) rid = reqId req callback = sendResponse rid . dynToJSON - Scheduler.sendRequest scheduler Nothing preq + Scheduler.sendRequest scheduler preq getNextReq :: IO (Maybe ReactorInput) getNextReq = do diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 27cbfa4c1..07fdf0651 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -69,6 +69,7 @@ import System.FilePath (()) import System.Exit import qualified System.Log.Logger as L import qualified Data.Rope.UTF16 as Rope +import GHC.Conc -- --------------------------------------------------------------------- {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} @@ -155,9 +156,9 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do -- haskell lsp sets the current directory to the project root in the InitializeRequest -- We launch the dispatcher after that so that the default cradle is -- recognized properly by ghc-mod - _ <- forkIO $ Scheduler.runScheduler scheduler errorHandler callbackHandler (Just lf) - _ <- forkIO reactorFunc - _ <- forkIO $ diagnosticsQueue tr + flip labelThread "scheduler" =<< (forkIO $ Scheduler.runScheduler scheduler errorHandler callbackHandler (Just lf)) + flip labelThread "reactor" =<< (forkIO reactorFunc) + flip labelThread "diagnostics" =<< (forkIO $ diagnosticsQueue tr) return Nothing diagnosticProviders :: Map.Map DiagnosticTrigger [(PluginId,DiagnosticProviderFunc)] @@ -217,30 +218,6 @@ getPrefixAtPos uri pos = do -- --------------------------------------------------------------------- -mapFileFromVfs :: (MonadIO m, MonadReader REnv m) - => TrackingNumber - -> J.VersionedTextDocumentIdentifier -> m () -mapFileFromVfs tn vtdi = do - let uri = vtdi ^. J.uri - ver = fromMaybe 0 (vtdi ^. J.version) - lf <- asks lspFuncs - vfsFunc <- asksLspFuncs Core.getVirtualFileFunc - mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri) - case (mvf, uriToFilePath uri) of - (Just (VFS.VirtualFile _ _ _), Just _fp) -> do - -- let text' = Rope.toString yitext - -- text = "{-# LINE 1 \"" ++ fp ++ "\"#-}\n" <> text' - -- TODO: @fendor, better document that, why do we even have this? - -- We have it to cancel operations that would operate on stale file versions - -- Maybe NotDidCloseDocument should call it, too? - let req = GReq tn (Just uri) Nothing Nothing (const $ return ()) () - $ return (IdeResultOk ()) - - updateDocumentRequest uri ver req - _ <- liftIO $ getPersistedFile' lf uri - return () - (_, _) -> return () - -- TODO: generalise this and move it to GhcMod.ModuleLoader updatePositionMap :: Uri -> [J.TextDocumentContentChangeEvent] -> IdeGhcM (IdeResult ()) updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file -> @@ -450,7 +427,7 @@ reactor inp diagIn = do Nothing -> return () renv <- ask - let hreq = GReq tn Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb + let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb callback Nothing = flip runReaderT renv $ reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning "No hoogle db found. Check the README for instructions to generate one" @@ -466,10 +443,10 @@ reactor inp diagIn = do let td = notification ^. J.params . J.textDocument uri = td ^. J.uri - ver = Just $ td ^. J.version - mapFileFromVfs tn $ J.VersionedTextDocumentIdentifier uri ver + ver = td ^. J.version + updateDocument uri ver -- We want to execute diagnostics for a newly opened file as soon as possible - requestDiagnostics $ DiagnosticsRequest DiagnosticOnOpen tn uri ver + requestDiagnostics $ DiagnosticsRequest DiagnosticOnOpen tn uri (Just ver) -- ------------------------------- @@ -489,11 +466,9 @@ reactor inp diagIn = do let td = notification ^. J.params . J.textDocument uri = td ^. J.uri - -- ver = Just $ td ^. J.version - ver = Nothing - mapFileFromVfs tn $ J.VersionedTextDocumentIdentifier uri ver + updateDocument uri 0 -- don't debounce/queue diagnostics when saving - requestDiagnostics (DiagnosticsRequest DiagnosticOnSave tn uri ver) + requestDiagnostics (DiagnosticsRequest DiagnosticOnSave tn uri Nothing) -- ------------------------------- @@ -505,8 +480,7 @@ reactor inp diagIn = do uri = vtdi ^. J.uri ver = vtdi ^. J.version J.List changes = params ^. J.contentChanges - mapFileFromVfs tn vtdi - makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) () $ + updateDocumentRequest uri (fromMaybe 0 ver) $ GReq tn "update-position" (Just uri) Nothing Nothing (const $ return ()) () $ -- Important - Call this before requestDiagnostics updatePositionMap uri changes @@ -523,7 +497,7 @@ reactor inp diagIn = do let uri = notification ^. J.params . J.textDocument . J.uri -- unmapFileFromVfs versionTVar cin uri - makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) () $ do + makeRequest $ GReq tn "delete-cache" (Just uri) Nothing Nothing (const $ return ()) () $ do forM_ (uriToFilePath uri) deleteCachedModule return $ IdeResultOk () @@ -535,7 +509,7 @@ reactor inp diagIn = do let (params, doc, pos) = reqParams req newName = params ^. J.newName callback = reactorSend . RspRename . Core.makeResponseMessage req - let hreq = GReq tn (Just doc) Nothing (Just $ req ^. J.id) callback mempty + let hreq = GReq tn "HaRe-rename" (Just doc) Nothing (Just $ req ^. J.id) callback mempty $ HaRe.renameCmd' doc pos newName makeRequest hreq @@ -565,7 +539,7 @@ reactor inp diagIn = do in reactorSend $ RspHover $ Core.makeResponseMessage req h hreq :: PluginRequest R - hreq = IReq tn (req ^. J.id) callback $ + hreq = IReq tn "hover" (req ^. J.id) callback $ sequence <$> mapM (\hp -> lift $ hp doc pos) hps makeRequest hreq liftIO $ U.logs "reactor:HoverRequest done" @@ -635,7 +609,7 @@ reactor inp diagIn = do "Invalid fallbackCodeAction params" -- Just an ordinary HIE command Just (plugin, cmd) -> - let preq = GReq tn Nothing Nothing (Just $ req ^. J.id) callback (toDynJSON (Nothing :: Maybe J.WorkspaceEdit)) + let preq = GReq tn "plugin" Nothing Nothing (Just $ req ^. J.id) callback (toDynJSON (Nothing :: Maybe J.WorkspaceEdit)) $ runPluginCommand plugin cmd cmdParams in makeRequest preq @@ -665,18 +639,19 @@ reactor inp diagIn = do Nothing -> callback [] Just prefix -> do snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "completion" (req ^. J.id) callback $ lift $ Completions.getCompletions doc prefix snippets makeRequest hreq ReqCompletionItemResolve req -> do liftIO $ U.logs $ "reactor:got CompletionItemResolveRequest:" ++ show req + snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn let origCompl = req ^. J.params callback res = do let rspMsg = Core.makeResponseMessage req $ res reactorSend $ RspCompletionItemResolve rspMsg - hreq = IReq tn (req ^. J.id) callback $ runIdeResultT $ do - lift $ lift $ Completions.resolveCompletion origCompl + hreq = IReq tn "completion" (req ^. J.id) callback $ runIdeResultT $ do + lift $ lift $ Completions.resolveCompletion snippets origCompl makeRequest hreq -- ------------------------------- @@ -685,7 +660,7 @@ reactor inp diagIn = do liftIO $ U.logs $ "reactor:got DocumentHighlightsRequest:" ++ show req let (_, doc, pos) = reqParams req callback = reactorSend . RspDocumentHighlights . Core.makeResponseMessage req . J.List - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "highlights" (req ^. J.id) callback $ Hie.getReferencesInDoc doc pos makeRequest hreq @@ -697,7 +672,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri pos = params ^. J.position callback = reactorSend . RspDefinition . Core.makeResponseMessage req - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "find-def" (req ^. J.id) callback $ fmap J.MultiLoc <$> Hie.findDef doc pos makeRequest hreq @@ -707,7 +682,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri pos = params ^. J.position callback = reactorSend . RspTypeDefinition . Core.makeResponseMessage req - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "type-def" (req ^. J.id) callback $ fmap J.MultiLoc <$> Hie.findTypeDef doc pos makeRequest hreq @@ -716,7 +691,7 @@ reactor inp diagIn = do -- TODO: implement project-wide references let (_, doc, pos) = reqParams req callback = reactorSend . RspFindReferences. Core.makeResponseMessage req . J.List - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "references" (req ^. J.id) callback $ fmap (map (J.Location doc . (^. J.range))) <$> Hie.getReferencesInDoc doc pos makeRequest hreq @@ -730,7 +705,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri withDocumentContents (req ^. J.id) doc $ \text -> let callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List - hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options) + hreq = IReq tn "format" (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options) in makeRequest hreq -- ------------------------------- @@ -743,7 +718,7 @@ reactor inp diagIn = do withDocumentContents (req ^. J.id) doc $ \text -> let range = params ^. J.range callback = reactorSend . RspDocumentRangeFormatting . Core.makeResponseMessage req . J.List - hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc (FormatRange range) (params ^. J.options) + hreq = IReq tn "range-format" (req ^. J.id) callback $ lift $ provider text doc (FormatRange range) (params ^. J.options) in makeRequest hreq -- ------------------------------- @@ -768,7 +743,7 @@ reactor inp diagIn = do in [si] <> children callback = reactorSend . RspDocumentSymbols . Core.makeResponseMessage req . convertSymbols . concat - let hreq = IReq tn (req ^. J.id) callback (sequence <$> mapM (\f -> f uri) sps) + let hreq = IReq tn "symbols" (req ^. J.id) callback (sequence <$> mapM (\f -> f uri) sps) makeRequest hreq -- ------------------------------- @@ -820,7 +795,7 @@ withDocumentContents reqId uri f = do (J.responseId reqId) J.InvalidRequest "Document was not open" - Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt) + Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt) -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. @@ -897,10 +872,10 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer let fakeId = J.IdString ("fake,remove:pid=" <> pid) -- TODO:AZ: IReq should take a Maybe LspId let reql = case ds of DiagnosticProviderSync dps -> - IReq trackingNumber fakeId callbackl + IReq trackingNumber "diagnostics" fakeId callbackl $ dps trigger file DiagnosticProviderAsync dpa -> - IReq trackingNumber fakeId pure + IReq trackingNumber "diagnostics-a" fakeId pure $ dpa trigger file callbackl -- This callback is used in R for the dispatcher normally, -- but also in IO if the plugin chooses to spawn an @@ -943,14 +918,14 @@ requestDiagnosticsNormal tn file mVer = do let sendHlint = hlintOn clientConfig when sendHlint $ do -- get hlint diagnostics - let reql = GReq tn (Just file) (Just (file,ver)) Nothing callbackl (PublishDiagnosticsParams file mempty) + let reql = GReq tn "apply-refact" (Just file) (Just (file,ver)) Nothing callbackl (PublishDiagnosticsParams file mempty) $ ApplyRefact.lintCmd' file callbackl (PublishDiagnosticsParams fp (List ds)) = sendOne "hlint" (J.toNormalizedUri fp, ds) makeRequest reql -- get GHC diagnostics and loads the typechecked module into the cache - let reqg = GReq tn (Just file) (Just (file,ver)) Nothing callbackg mempty + let reqg = GReq tn "typecheck" (Just file) (Just (file,ver)) Nothing callbackg mempty $ BIOS.setTypecheckedModule file callbackg (HIE.Diagnostics pd, errs) = do forM_ errs $ \e -> do @@ -987,18 +962,22 @@ syncOptions = J.TextDocumentSyncOptions , J._save = Just $ J.SaveOptions $ Just False } +-- | Create 'Language.Haskell.LSP.Core.Options'. +-- There may need to be more options configured, depending on what handlers +-- are registered. +-- Consult the haskell-lsp haddocks to see all possible options. hieOptions :: [T.Text] -> Core.Options hieOptions commandIds = def { Core.textDocumentSync = Just syncOptions - , Core.completionProvider = Just (J.CompletionOptions (Just True) (Just ["."])) - , Core.typeDefinitionProvider = Just (J.GotoOptionsStatic True) + -- The characters that trigger completion automatically. + , Core.completionTriggerCharacters = Just ['.'] -- As of 2018-05-24, vscode needs the commands to be registered -- otherwise they will not be available as codeActions (will be -- silently ignored, despite UI showing to the contrary). -- -- Hopefully the end May 2018 vscode release will stabilise -- this, it is a major rework of the machinery anyway. - , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List commandIds)) + , Core.executeCommandCommands = Just commandIds } diff --git a/src/Haskell/Ide/Engine/Types.hs b/src/Haskell/Ide/Engine/Types.hs index acca4fa8f..cfd38d35a 100644 --- a/src/Haskell/Ide/Engine/Types.hs +++ b/src/Haskell/Ide/Engine/Types.hs @@ -18,6 +18,7 @@ type TrackingNumber = Int -- | Requests are parametric in the monad m -- that their callback expects to be in. pattern GReq :: TrackingNumber + -> String -> Maybe Uri -> Maybe (Uri, Int) -> Maybe J.LspId @@ -25,15 +26,16 @@ pattern GReq :: TrackingNumber -> a1 -> IdeGhcM (IdeResult a1) -> PluginRequest m -pattern GReq a b c d e f g= Right (GhcRequest a b c d e f g) +pattern GReq a s b c d e f g = Right (GhcRequest a s b c d e f g) -pattern IReq :: TrackingNumber -> J.LspId -> RequestCallback m a -> IdeDeferM (IdeResult a) -> Either (IdeRequest m) b -pattern IReq a b c d = Left (IdeRequest a b c d) +pattern IReq :: TrackingNumber -> String -> J.LspId -> RequestCallback m a -> IdeDeferM (IdeResult a) -> Either (IdeRequest m) b +pattern IReq a s b c d = Left (IdeRequest a s b c d) type PluginRequest m = Either (IdeRequest m) (GhcRequest m) data GhcRequest m = forall a. GhcRequest { pinMsgNum :: TrackingNumber -- ^ Exists to facilitate logging/tracing + , pinDesc :: String -- ^ Description of the request for debugging , pinContext :: Maybe J.Uri , pinDocVer :: Maybe (J.Uri, Int) , pinLspReqId :: Maybe J.LspId @@ -44,6 +46,7 @@ data GhcRequest m = forall a. GhcRequest data IdeRequest m = forall a. IdeRequest { pureMsgNum :: TrackingNumber -- ^ Exists to facilitate logging/tracing + , pureDesc :: String , pureReqId :: J.LspId , pureReqCallback :: RequestCallback m a , pureReq :: IdeDeferM (IdeResult a) diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml deleted file mode 100644 index 3ecd8bbed..000000000 --- a/stack-8.2.2.yaml +++ /dev/null @@ -1,68 +0,0 @@ -resolver: lts-11.18 # lts-11.x is the last one for GHC 8.2.2 -packages: -- . -- hie-plugin-api - -extra-deps: -- ./hie-bios -- ./submodules/HaRe -- ./submodules/cabal-helper -- ./submodules/ghc-mod -- ./submodules/ghc-mod/core -- ./submodules/ghc-mod/ghc-project-types - -- brittany-0.12.0.0 -- butcher-1.3.1.1 -- bytestring-trie-0.2.5.0 -- cabal-plan-0.5.0.0 -- conduit-parse-0.2.1.0 -- constrained-dynamic-0.1.0.0 -- czipwith-1.0.1.0 -- floskell-0.10.0 -- ghc-exactprint-0.5.8.2 -- haddock-api-2.18.1 -- haddock-library-1.4.4 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 -- haskell-src-exts-1.21.0 -- haskell-src-exts-util-0.2.5 -- hlint-2.1.17 # last hlint supporting GHC 8.2 -- hoogle-5.0.17.9 -- hsimport-0.8.8 -- lsp-test-0.8.0.0 -- monad-dijkstra-0.1.1.2 -- pretty-show-1.8.2 -- rope-utf16-splay-0.3.1.0 -- sorted-list-0.2.1.0 -- syz-0.2.0.0 -# To make build work in windows 7 -- unix-time-0.4.7 -- ghc-boot-8.2.2 -## introduced by hie-bios -#- hie-bios-0.2.1 -- extra-1.6.18 -- unix-compat-0.5.2 -- yaml-0.11.1.2 -- unordered-containers-0.2.10.0 -- directory-1.3.0.2 -- file-embed-0.0.11 -- filepath-1.4.1.2 -- libyaml-0.1.1.0 -- transformers-0.5.6.2 -- process-1.6.1.0 -- binary-0.8.5.1 -- unix-2.7.2.2 -# - Win32-2.6.2. -- time-1.8.0.2 - - -flags: - haskell-ide-engine: - pedantic: true - hie-plugin-api: - pedantic: true - -nix: - packages: [ icu libcxx zlib ] - -concurrent-tests: false diff --git a/stack-8.4.2.yaml b/stack-8.4.2.yaml index 3fc221f59..968789061 100644 --- a/stack-8.4.2.yaml +++ b/stack-8.4.2.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml index 27c45dd9c..851d496a0 100644 --- a/stack-8.4.3.yaml +++ b/stack-8.4.3.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml index 4d9e426cb..a7999d612 100644 --- a/stack-8.4.4.yaml +++ b/stack-8.4.4.yaml @@ -18,14 +18,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - optparse-simple-0.1.0 - pretty-show-1.9.5 diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml index f44c5243c..bd151c8a7 100644 --- a/stack-8.6.1.yaml +++ b/stack-8.6.1.yaml @@ -22,14 +22,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - monoid-subclasses-0.4.6.1 diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml index 58fbb0145..081d5799c 100644 --- a/stack-8.6.2.yaml +++ b/stack-8.6.2.yaml @@ -18,14 +18,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml index 1a4ea69e5..3f0f75283 100644 --- a/stack-8.6.3.yaml +++ b/stack-8.6.3.yaml @@ -17,14 +17,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index cac2b21bd..49a0188b7 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -17,13 +17,13 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 5a631f631..d20e0041c 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -18,12 +18,12 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - hlint-2.2.3 - hsimport-0.11.0 - hoogle-5.0.17.11 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - syz-0.2.0.0 - temporary-1.2.1.1 diff --git a/stack.yaml b/stack.yaml index 2f4a9bafb..2c7709c8c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -19,11 +19,11 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - hlint-2.2.3 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - syz-0.2.0.0 - temporary-1.2.1.1 diff --git a/submodules/HaRe b/submodules/HaRe index 03de75229..26d1048d3 160000 --- a/submodules/HaRe +++ b/submodules/HaRe @@ -1 +1 @@ -Subproject commit 03de7522995a3b192c3a2b010539d02e753e3d3d +Subproject commit 26d1048d30ac5d995af46b35c9988172ecfb1f3e diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 348b19e78..0704992ae 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -74,12 +74,13 @@ startServer :: IO (Scheduler IO, TChan LogVal, ThreadId) startServer = do scheduler <- newScheduler plugins testOptions logChan <- newTChanIO - dispatcher <- forkIO $ + dispatcher <- forkIO $ do + flushStackEnvironment runScheduler - scheduler - (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e))) - (\g x -> g x) - def + scheduler + (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e))) + (\g x -> g x) + def return (scheduler, logChan, dispatcher) @@ -101,9 +102,9 @@ dispatchGhcRequest tn uri ctx n scheduler lc plugin com arg = do logger :: RequestCallback IO DynamicJSON logger x = logToChan lc (ctx, Right x) - let req = GReq tn uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $ + let req = GReq tn "plugin-command" uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $ runPluginCommand plugin com (toJSON arg) - sendRequest scheduler Nothing req + sendRequest scheduler req dispatchIdeRequest :: (Typeable a, ToJSON a) @@ -114,8 +115,8 @@ dispatchIdeRequest tn ctx scheduler lc lid f = do logger :: (Typeable a, ToJSON a) => RequestCallback IO a logger x = logToChan lc (ctx, Right (toDynJSON x)) - let req = IReq tn lid logger f - sendRequest scheduler Nothing req + let req = IReq tn "dispatch" lid logger f + sendRequest scheduler req -- --------------------------------------------------------------------- diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index cce4d22d2..274fbc4bc 100644 --- a/test/functional/CompletionSpec.hs +++ b/test/functional/CompletionSpec.hs @@ -120,7 +120,7 @@ spec = describe "completions" $ do item ^. label `shouldBe` "OPTIONS_GHC" item ^. kind `shouldBe` Just CiKeyword item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just ("OPTIONS_GHC -${1:option} #-}") + item ^. insertText `shouldBe` Just "OPTIONS_GHC -${1:option} #-}" -- ----------------------------------- @@ -358,4 +358,12 @@ spec = describe "completions" $ do item ^. kind `shouldBe` Just CiFunction item ^. insertTextFormat `shouldBe` Just PlainText item ^. insertText `shouldBe` Nothing + + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "foldl" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just PlainText + resolved ^. insertText `shouldBe` Nothing noSnippetsCaps = (textDocument . _Just . completion . _Just . completionItem . _Just . snippetSupport ?~ False) fullCaps diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index ef176d4d1..e0ccd04b6 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module FunctionalCodeActionsSpec where @@ -213,34 +212,34 @@ spec = describe "code actions" $ do ] ] describe "add package suggestions" $ do - -- Only execute this test with ghc 8.4.4, below seems to be broken in the package. -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) - it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do - doc <- openDoc "AddPackage.hs" "haskell" + it "adds to .cabal files" $ do + flushStackEnvironment + runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do + doc <- openDoc "AddPackage.hs" "haskell" - -- ignore the first empty hlint diagnostic publish - [_,diag:_] <- count 2 waitForDiagnostics + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics - let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6 - , "Could not find module `Data.Text'" -- Windows - , "Could not load module ‘Data.Text’" -- GHC >= 8.6 - , "Could not find module ‘Data.Text’" - ] - in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes + let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6 + , "Could not find module `Data.Text'" -- Windows + , "Could not load module ‘Data.Text’" -- GHC >= 8.6 + , "Could not find module ‘Data.Text’" + ] + in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes - acts <- getAllCodeActions doc - let (CACodeAction action:_) = acts + acts <- getAllCodeActions doc + let (CACodeAction action:_) = acts - liftIO $ do - action ^. L.title `shouldBe` "Add text as a dependency" - action ^. L.kind `shouldBe` Just CodeActionQuickFix - action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" + liftIO $ do + action ^. L.title `shouldBe` "Add text as a dependency" + action ^. L.kind `shouldBe` Just CodeActionQuickFix + action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" - executeCodeAction action + executeCodeAction action + + contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" + liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16] - contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" - liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16] -#endif it "adds to hpack package.yaml files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do doc <- openDoc "app/Asdf.hs" "haskell" diff --git a/test/functional/FunctionalLiquidSpec.hs b/test/functional/FunctionalLiquidSpec.hs index 22d6228d7..154b7c92c 100644 --- a/test/functional/FunctionalLiquidSpec.hs +++ b/test/functional/FunctionalLiquidSpec.hs @@ -101,11 +101,16 @@ spec = describe "liquid haskell diagnostics" $ do -- liftIO $ show diags3 `shouldBe` "" liftIO $ do length diags3 `shouldBe` 1 - d ^. range `shouldBe` Range (Position 8 0) (Position 8 7) + d ^. range `shouldBe` Range (Position 8 0) (Position 8 11) d ^. severity `shouldBe` Just DsError d ^. code `shouldBe` Nothing d ^. source `shouldBe` Just "liquid" - d ^. message `shouldSatisfy` (T.isPrefixOf "Error: Liquid Type Mismatch\n Inferred type\n VV : {v : Int | v == (7 : int)}\n \n not a subtype of Required type\n VV : {VV : Int | VV mod 2 == 0}\n") + d ^. message `shouldSatisfy` T.isPrefixOf ("Error: Liquid Type Mismatch\n" <> + " Inferred type\n" <> + " VV : {v : GHC.Types.Int | v == 7}\n" <> + " \n" <> + " not a subtype of Required type\n" <> + " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ") -- --------------------------------------------------------------------- diff --git a/test/plugin-dispatcher/Main.hs b/test/plugin-dispatcher/Main.hs index d6a125ee0..e06d84e4b 100644 --- a/test/plugin-dispatcher/Main.hs +++ b/test/plugin-dispatcher/Main.hs @@ -34,20 +34,21 @@ newPluginSpec = do let defCallback = atomically . writeTChan outChan delayedCallback = \r -> threadDelay 10000 >> defCallback r - let req0 = GReq 0 Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ IdeResultOk $ T.pack "text0" - req1 = GReq 1 Nothing Nothing (Just $ IdInt 1) defCallback "none" $ return $ IdeResultOk $ T.pack "text1" - req2 = GReq 2 Nothing Nothing (Just $ IdInt 2) delayedCallback "none" $ return $ IdeResultOk $ T.pack "text2" - req3 = GReq 3 Nothing (Just (filePathToUri "test", 2)) Nothing defCallback "none" $ return $ IdeResultOk $ T.pack "text3" - req4 = GReq 4 Nothing Nothing (Just $ IdInt 3) defCallback "none" $ return $ IdeResultOk $ T.pack "text4" + let req0 = GReq 0 "0" Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ IdeResultOk $ T.pack "text0" + req1 = GReq 1 "1" Nothing Nothing (Just $ IdInt 1) defCallback "none" $ return $ IdeResultOk $ T.pack "text1" + req2 = GReq 2 "2" Nothing Nothing (Just $ IdInt 2) delayedCallback "none" $ return $ IdeResultOk $ T.pack "text2" + req3 = GReq 3 "3" Nothing (Just (filePathToUri "test", 2)) Nothing defCallback "none" $ return $ IdeResultOk $ T.pack "text3" + req4 = GReq 4 "4" Nothing Nothing (Just $ IdInt 3) defCallback "none" $ return $ IdeResultOk $ T.pack "text4" - let makeReq = sendRequest scheduler Nothing + let makeReq = sendRequest scheduler pid <- forkIO $ runScheduler scheduler (\_ _ _ -> return ()) (\f x -> f x) def - sendRequest scheduler (Just (filePathToUri "test", 3)) req0 + updateDocument scheduler (filePathToUri "test") 3 + sendRequest scheduler req0 makeReq req1 makeReq req2 cancelRequest scheduler (IdInt 2) diff --git a/test/unit/ApplyRefactPluginSpec.hs b/test/unit/ApplyRefactPluginSpec.hs index ac5445f45..d70eae0ff 100644 --- a/test/unit/ApplyRefactPluginSpec.hs +++ b/test/unit/ApplyRefactPluginSpec.hs @@ -100,7 +100,6 @@ applyRefactSpec = do PublishDiagnosticsParams { _uri = filePath , _diagnostics = List -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) [Diagnostic {_range = Range { _start = Position {_line = 12, _character = 23} , _end = Position {_line = 12, _character = 100000}} , _severity = Just DsInfo @@ -108,23 +107,6 @@ applyRefactSpec = do , _source = Just "hlint" , _message = T.pack filePathNoUri <> ":13:24: error:\n Operator applied to too few arguments: +\n data instance Sing (z :: (a :~: b)) where\n> SRefl :: Sing Refl +\n\n" , _relatedInformation = Nothing }]} -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0))) - [Diagnostic {_range = Range { _start = Position {_line = 13, _character = 0} - , _end = Position {_line = 13, _character = 100000}} - , _severity = Just DsInfo - , _code = Just (StringValue "parser") - , _source = Just "hlint" - , _message = "Parse error: virtual }\n data instance Sing (z :: (a :~: b)) where\n SRefl :: Sing Refl +\n> \n\n" - , _relatedInformation = Nothing }]} -#else - [Diagnostic {_range = Range { _start = Position {_line = 11, _character = 28} - , _end = Position {_line = 11, _character = 100000}} - , _severity = Just DsInfo - , _code = Just "parser" - , _source = Just "hlint" - , _message = "Parse error: :~:\n import Data.Type.Equality ((:~:) (..), (:~~:) (..))\n \n> data instance Sing (z :: (a :~: b)) where\n SRefl :: Sing Refl +\n\n" - , _relatedInformation = Nothing }]} -#endif testCommand testPlugins act "applyrefact" "lint" arg res -- --------------------------------- diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs index dbbaaeb4c..39558f4a3 100644 --- a/test/unit/GhcModPluginSpec.hs +++ b/test/unit/GhcModPluginSpec.hs @@ -482,11 +482,6 @@ ghcmodSpec = , (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS") , (Range (toPos (33, 15)) (toPos (33, 19)), "Test -> String") , (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS") -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -#else - , (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS") - , (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS") -#endif ] testCommand testPlugins act "generic" "type" arg res @@ -501,11 +496,6 @@ ghcmodSpec = [ (Range (toPos (33, 21)) (toPos (33, 23)), "(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test") , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -#else - , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") - , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") -#endif ] testCommand testPlugins act "generic" "type" arg res diff --git a/test/unit/LiquidSpec.hs b/test/unit/LiquidSpec.hs index 2acafe4fd..16191fb6a 100644 --- a/test/unit/LiquidSpec.hs +++ b/test/unit/LiquidSpec.hs @@ -3,16 +3,19 @@ module LiquidSpec where import Data.Aeson +import Data.List import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Monoid ((<>)) -import Data.Maybe (isJust) import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Plugin.Liquid import System.Directory +import System.Exit import System.FilePath +import System.Process import Test.Hspec +-- import Control.Monad.IO.Class main :: IO () main = hspec spec @@ -24,22 +27,27 @@ spec = do -- --------------------------------- - it "finds liquid haskell exe in $PATH" $ findExecutable "liquid" >>= (`shouldSatisfy` isJust) + it "the liquid haskell exe in $PATH has the supported version" $ do + mexe <- findExecutable "liquid" + case mexe of + Nothing -> expectationFailure "liquid haskell exe is NOT in $PATH" + Just exe -> do + version <- readProcess exe ["--numeric-version"] "" + version `shouldSatisfy` isPrefixOf "0.8.6.2" -- --------------------------------- - -- AZ: this test has been moved to func-tests, stack > 2.1 sets - -- its own package environment, we can't run it from here. - - -- -- This produces some products in /test/testdata/liquid/.liquid/ that is used in subsequent test - -- it "runs the liquid haskell exe" $ do - -- let - -- fp = cwd "test/testdata/liquid/Evens.hs" - -- -- fp = "/home/alanz/tmp/haskell-proc-play/Evens.hs" - -- -- uri = filePathToUri fp - -- Just (ef, (msg:_)) <- runLiquidHaskell fp - -- msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\":9,\"column\":1},\"stop\":{\"line\":9,\"column\":8},\"message\":\"Error: Liquid Type Mismatch\\n Inferred type\\n VV : {v : Int | v == (7 : int)}\\n \\n not a subtype of Required type\\n VV : {VV : Int | VV mod 2 == 0}\\n" - -- ef `shouldBe` ExitFailure 1 + -- This produces some products in /test/testdata/liquid/.liquid/ + -- that are used in subsequent test + it "runs the liquid haskell exe" $ do + let + fp = cwd "test/testdata/liquid/Evens.hs" + Just (ef, (msg:_)) <- runLiquidHaskell fp + -- liftIO $ putStrLn $ "msg=" ++ msg + -- liftIO $ putStrLn $ "msg=" ++ unlines (drop 3 (lines msg)) + let msg' = unlines (drop 3 (lines msg)) + msg' `shouldSatisfy` isInfixOf "RESULT\n[{\"start\":{\"line\"" + ef `shouldBe` ExitFailure 1 -- --------------------------------- it "gets annot file paths" $ do @@ -60,12 +68,15 @@ spec = do let Just v = decode jf :: Maybe LiquidJson let [LE { start, stop, message }] = errors v start `shouldBe` LP 9 1 - stop `shouldBe` LP 9 8 + stop `shouldBe` LP 9 12 message `shouldSatisfy` T.isPrefixOf - ("Error: Liquid Type Mismatch\n Inferred type\n" <> - " VV : {v : Int | v == (7 : int)}\n \n" <> + ("Error: Liquid Type Mismatch\n" <> + " Inferred type\n" <> + " VV : {v : GHC.Types.Int | v == 7}\n" <> + " \n" <> " not a subtype of Required type\n" <> - " VV : {VV : Int | VV mod 2 == 0}\n") + " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n" <> + " ") -- --------------------------------- @@ -100,8 +111,8 @@ spec = do take 2 ts `shouldBe` [LE (LP 1 1) (LP 1 1) "GHC.Types.Module" - ,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"] - length ts `shouldBe` 38 + ,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"] + length ts `shouldBe` 53 -- --------------------------------- @@ -112,8 +123,8 @@ spec = do take 2 ts `shouldBe` [LE (LP 1 1) (LP 1 1) "GHC.Types.Module" - ,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"] - length ts `shouldBe` 38 + ,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"] + length ts `shouldBe` 53 -- --------------------------------- diff --git a/test/unit/PackagePluginSpec.hs b/test/unit/PackagePluginSpec.hs index d9b950858..8254b1186 100644 --- a/test/unit/PackagePluginSpec.hs +++ b/test/unit/PackagePluginSpec.hs @@ -64,7 +64,6 @@ packageSpec = do args = AddParams fp (fp "AddPackage.hs") "text" act = addCmd' args textEdits = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) List [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat [ "cabal-version: >=1.10\n" @@ -85,25 +84,6 @@ packageSpec = do , " text -any" ] ] -#else - List -- TODO: this seems to indicate that the command does nothing - [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat - [ "name: add-package-test\n" - , "version: 0.1.0.0\n" - , "cabal-version: >=1.10\n" - , "build-type: Simple\n" - , "license: BSD3\n" - , "maintainer: luke_lau@icloud.com\n" - , "author: Luke Lau\n" - , "extra-source-files:\n" - , " ChangeLog.md" - ] - , TextEdit (Range (Position 9 0) (Position 13 34)) $ T.concat - [ "executable AddPackage\n" - , " main-is: AddPackage.hs\n" - ] - ] -#endif res = IdeResultOk $ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing testCommand testPlugins act "package" "add" args res @@ -117,7 +97,6 @@ packageSpec = do args = AddParams fp (fp "AddPackage.hs") "text" act = addCmd' args textEdits = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) List [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat [ "cabal-version: >=1.10\n" @@ -139,29 +118,6 @@ packageSpec = do , " text -any" ] ] -#else - List - [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat - [ "name: add-package-test\n" - , "version: 0.1.0.0\n" - , "cabal-version: >=1.10\n" - , "build-type: Simple\n" - , "license: BSD3\n" - , "maintainer: luke_lau@icloud.com\n" - , "author: Luke Lau\n" - , "extra-source-files:\n" - , " ChangeLog.md" - ] - , TextEdit (Range (Position 10 0) (Position 13 34)) $ T.concat - [ " exposed-modules:\n" - , " AddPackage\n" - , " build-depends:\n" - , " base >=4.7 && <5,\n" - , " text -any\n" - , " default-language: Haskell2010\n" - ] - ] -#endif res = IdeResultOk $ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing testCommand testPlugins act "package" "add" args res diff --git a/test/utils/TestUtils.hs b/test/utils/TestUtils.hs index e0ed044d9..a03c5c0a9 100644 --- a/test/utils/TestUtils.hs +++ b/test/utils/TestUtils.hs @@ -15,6 +15,7 @@ module TestUtils , hieCommandExamplePlugin , getHspecFormattedConfig , testOptions + , flushStackEnvironment ) where import Control.Concurrent.STM @@ -52,6 +53,7 @@ testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose } testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) => IdePlugins -> IdeGhcM (IdeResult b) -> PluginId -> CommandName -> a -> IdeResult b -> IO () testCommand testPlugins act plugin cmd arg res = do + flushStackEnvironment (newApiRes, oldApiRes) <- runIGM testPlugins $ do new <- act old <- makeRequest plugin cmd arg @@ -166,12 +168,6 @@ stackYaml = "stack-8.4.3.yaml" #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,2,0))) "stack-8.4.2.yaml" -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0))) - "stack-8.2.2.yaml" -#elif __GLASGOW_HASKELL__ >= 802 - "stack-8.2.1.yaml" -#else - "stack-8.0.2.yaml" #endif logFilePath :: String @@ -322,3 +318,14 @@ xmlFormatter = silent { -- --------------------------------------------------------------------- +flushStackEnvironment :: IO () +flushStackEnvironment = do + -- We need to clear these environment variables to prevent + -- collisions with stack usages + -- See https://github.com/commercialhaskell/stack/issues/4875 + unsetEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "HASKELL_PACKAGE_SANDBOX" + unsetEnv "HASKELL_PACKAGE_SANDBOXES" + +-- ---------------------------------------------------------------------