haskell-language-server 1.7.0.0 → 1.8.0.0
raw patch · 20 files changed
+1266/−917 lines, 20 filesdep +ghcide-benchdep +hls-code-range-plugindep +hls-explicit-fixity-plugindep −hls-selection-range-plugindep ~basedep ~ghcidedep ~hls-alternate-number-format-plugin
Dependencies added: ghcide-bench, hls-code-range-plugin, hls-explicit-fixity-plugin, hls-gadt-plugin, hls-refactor-plugin, hls-stan-plugin, hslogger, shake, shake-bench, unliftio-core, yaml
Dependencies removed: hls-selection-range-plugin
Dependency ranges changed: base, ghcide, hls-alternate-number-format-plugin, hls-call-hierarchy-plugin, hls-class-plugin, hls-eval-plugin, hls-fourmolu-plugin, hls-haddock-comments-plugin, hls-hlint-plugin, hls-module-name-plugin, hls-plugin-api, hls-tactics-plugin, hls-test-utils
Files
- ChangeLog.md +262/−0
- README.md +1/−0
- bench/Main.hs +282/−0
- exe/Main.hs +36/−15
- exe/Plugins.hs +0/−200
- exe/Wrapper.hs +185/−45
- haskell-language-server.cabal +219/−129
- plugins/default/src/Ide/Plugin/Example.hs +0/−253
- plugins/default/src/Ide/Plugin/Example2.hs +0/−237
- src/HlsPlugins.hs +223/−0
- src/Ide/Main.hs +11/−12
- src/Ide/Version.hs +14/−6
- test/functional/Completion.hs +12/−2
- test/functional/Diagnostic.hs +1/−16
- test/functional/Format.hs +8/−1
- test/functional/FunctionalCodeAction.hs +2/−0
- test/functional/HieBios.hs +1/−1
- test/testdata/completion/AssociatedTypeFamily.hs +8/−0
- test/testdata/hieBiosError/hie.yaml +0/−0
- test/testdata/wErrorTest/src/WError.hs +1/−0
ChangeLog.md view
@@ -1,5 +1,267 @@ # Changelog for haskell-language-server +## 1.8.0.0++- Binaries for GHC 9.2.3 and GHC 9.2.4+- Initial support for GHC 9.4 with binaries for GHC 9.4.1 and GHC 9.4.2+- Startup time and performance improvements on projects using Template Haskell by serializing intermediate core (#2813)+- Memory usage improvements due to using a packed representation for filepaths (#3067, @kokobd)+- Improvements for hls-class-plugin (#2920, @July541) +- The new hls-gadt-plugin (#2899, @July541)+- Moving code actions from ghcide to the new hls-refactor-plugin (#3091, @wz1000)+- Many more improvements and bug fixes thanks to our contributors!++### Pull requests merged for 1.8.0.0++- Alternate Number Format Plugin buildable with GHC 9.4+([#3138](https://github.com/haskell/haskell-language-server/pull/3138)) by @drsooch+- Enable a bunch of plugins that build with ghc 9.4+([#3136](https://github.com/haskell/haskell-language-server/pull/3136)) by @pepeiborra+- Enable support for 9.4 on windows+([#3132](https://github.com/haskell/haskell-language-server/pull/3132)) by @wz1000+- flake.nix Add ghcide-bench to sourceDirs+([#3125](https://github.com/haskell/haskell-language-server/pull/3125)) by @akshaymankar+- Update hls-retrie-plugin to be usable with 9.2.4.+([#3120](https://github.com/haskell/haskell-language-server/pull/3120)) by @drsooch+- Add link to homepage and issues for `hie-compat`+([#3119](https://github.com/haskell/haskell-language-server/pull/3119)) by @parsonsmatt+- Remove pluginId from getNormalizedFilePath error message+([#3118](https://github.com/haskell/haskell-language-server/pull/3118)) by @drsooch+- HLS benchmarks+([#3117](https://github.com/haskell/haskell-language-server/pull/3117)) by @pepeiborra+- Fix --testing+([#3113](https://github.com/haskell/haskell-language-server/pull/3113)) by @pepeiborra+- Deduplicate HLS plugins+([#3112](https://github.com/haskell/haskell-language-server/pull/3112)) by @pepeiborra+- Do not send Heap Stats to the LSP log+([#3111](https://github.com/haskell/haskell-language-server/pull/3111)) by @pepeiborra+- Send begin progress message synchronously+([#3110](https://github.com/haskell/haskell-language-server/pull/3110)) by @pepeiborra+- Remove unused config in hls-class-plugin+([#3107](https://github.com/haskell/haskell-language-server/pull/3107)) by @July541+- Support fourmolu-0.8.1.0+([#3103](https://github.com/haskell/haskell-language-server/pull/3103)) by @brandonchinn178+- Probe-tools: Print stack ghc version+([#3093](https://github.com/haskell/haskell-language-server/pull/3093)) by @andys8+- Fix #3047+([#3092](https://github.com/haskell/haskell-language-server/pull/3092)) by @July541+- Remove exactprint dependencies from ghcide by introducing hls-refactor-plugin.+([#3091](https://github.com/haskell/haskell-language-server/pull/3091)) by @wz1000+- Stan: Avoid terminal colors in messages+([#3090](https://github.com/haskell/haskell-language-server/pull/3090)) by @andys8+- Support ghc-9.2.4+([#3085](https://github.com/haskell/haskell-language-server/pull/3085)) by @July541+- Bump Nix flake GHC 9.2.3 to 9.2.4+([#3081](https://github.com/haskell/haskell-language-server/pull/3081)) by @cydparser+- fix lsp-types benchmark+([#3079](https://github.com/haskell/haskell-language-server/pull/3079)) by @pepeiborra+- Add support for Fourmolu 0.8+([#3078](https://github.com/haskell/haskell-language-server/pull/3078)) by @brandonchinn178+- upgrade lsp to 1.5+([#3072](https://github.com/haskell/haskell-language-server/pull/3072)) by @kokobd+- Bump actions/cache from 2 to 3+([#3071](https://github.com/haskell/haskell-language-server/pull/3071)) by @dependabot[bot]+- Bump actions/setup-python from 3 to 4+([#3070](https://github.com/haskell/haskell-language-server/pull/3070)) by @dependabot[bot]+- Run the benchmark suite on GHC 9.2.3+([#3069](https://github.com/haskell/haskell-language-server/pull/3069)) by @pepeiborra+- Simplify instructions about 'ghcup compile hls'+([#3068](https://github.com/haskell/haskell-language-server/pull/3068)) by @hasufell+- Improve performance of NormalizedFilePath+([#3067](https://github.com/haskell/haskell-language-server/pull/3067)) by @kokobd+- add a prefix to plugin CPP definitions+([#3065](https://github.com/haskell/haskell-language-server/pull/3065)) by @kokobd+- Add Github precommit workflow+([#3060](https://github.com/haskell/haskell-language-server/pull/3060)) by @lunaticare+- Run pre-commit hooks+([#3059](https://github.com/haskell/haskell-language-server/pull/3059)) by @lunaticare+- Fix grammar and spelling errors in configuration.md+([#3056](https://github.com/haskell/haskell-language-server/pull/3056)) by @arsenkhy+- Remove redundant WARNING prefix+([#3055](https://github.com/haskell/haskell-language-server/pull/3055)) by @michaelpj+- fix a typo in src/Ide/Plugin/Class/CodeLens.hs+([#3053](https://github.com/haskell/haskell-language-server/pull/3053)) by @tensorknower69+- fix record-dot-syntax test+([#3051](https://github.com/haskell/haskell-language-server/pull/3051)) by @coltenwebb+- build(nix): ghc922 -> ghc923+([#3049](https://github.com/haskell/haskell-language-server/pull/3049)) by @teto+- build(nix): bumped gitignore dependency+([#3048](https://github.com/haskell/haskell-language-server/pull/3048)) by @teto+- Update issue templates+([#3044](https://github.com/haskell/haskell-language-server/pull/3044)) by @michaelpj+- Simplify hlint config+([#3038](https://github.com/haskell/haskell-language-server/pull/3038)) by @michaelpj+- handle trailing comma in import list properly+([#3035](https://github.com/haskell/haskell-language-server/pull/3035)) by @kokobd+- upgrade ghc-check to fix #3002+([#3034](https://github.com/haskell/haskell-language-server/pull/3034)) by @kokobd+- Fix Stack build with Nix on macOS+([#3031](https://github.com/haskell/haskell-language-server/pull/3031)) by @lunaticare+- haskell-language-server: add lower bound for githash+([#3030](https://github.com/haskell/haskell-language-server/pull/3030)) by @Bodigrim+- hls-eval-plugin: add lower bound for parser-combinators+([#3029](https://github.com/haskell/haskell-language-server/pull/3029)) by @Bodigrim+- hls-fourmolu-plugin: add lower bound for process-extras+([#3028](https://github.com/haskell/haskell-language-server/pull/3028)) by @Bodigrim+- ghcide: lower bounds+([#3025](https://github.com/haskell/haskell-language-server/pull/3025)) by @Bodigrim+- remove all usages of pre-commit-check in nix+([#3024](https://github.com/haskell/haskell-language-server/pull/3024)) by @kokobd+- hls-plugin-api: add lower bounds+([#3022](https://github.com/haskell/haskell-language-server/pull/3022)) by @Bodigrim+- hls-graph: add lower bound for async+([#3021](https://github.com/haskell/haskell-language-server/pull/3021)) by @Bodigrim+- Hlint: CodeAction with isPreferred+([#3018](https://github.com/haskell/haskell-language-server/pull/3018)) by @andys8+- Record Dot Hover Types+([#3016](https://github.com/haskell/haskell-language-server/pull/3016)) by @coltenwebb+- re-enable haddock+([#3015](https://github.com/haskell/haskell-language-server/pull/3015)) by @kokobd+- add Helix to configuration.md+([#3014](https://github.com/haskell/haskell-language-server/pull/3014)) by @0rphee+- Renaming of indirect references (RecordFieldPuns)+([#3013](https://github.com/haskell/haskell-language-server/pull/3013)) by @OliverMadine+- Revert back to Warning not Error in Logging `ResponseErrors`+([#3009](https://github.com/haskell/haskell-language-server/pull/3009)) by @drsooch+- Disable flaky test on Windows+([#3008](https://github.com/haskell/haskell-language-server/pull/3008)) by @michaelpj+- Improve troubleshooting and installation docs a bit+([#3004](https://github.com/haskell/haskell-language-server/pull/3004)) by @michaelpj+- refactor selection range plugin+([#3003](https://github.com/haskell/haskell-language-server/pull/3003)) by @kokobd+- Hlint more partial functions, and Debug.Trace+([#3000](https://github.com/haskell/haskell-language-server/pull/3000)) by @michaelpj+- Don't use typecheck rule for non FOIs in refine imports plugin+([#2995](https://github.com/haskell/haskell-language-server/pull/2995)) by @wz1000+- GHC 9.4 compatibility + Multiple Home Units+([#2994](https://github.com/haskell/haskell-language-server/pull/2994)) by @wz1000+- unify pre-commit hook & update Gitpod config+([#2991](https://github.com/haskell/haskell-language-server/pull/2991)) by @kokobd+- Log response errors returned from Plugins+([#2988](https://github.com/haskell/haskell-language-server/pull/2988)) by @drsooch+- Add associated type families to local completions+([#2987](https://github.com/haskell/haskell-language-server/pull/2987)) by @gasparattila+- Remove some partial functions from Shake.hs+([#2986](https://github.com/haskell/haskell-language-server/pull/2986)) by @michaelpj+- Clean up ghc-9.0 partial support contents+([#2983](https://github.com/haskell/haskell-language-server/pull/2983)) by @July541+- fix new import position+([#2981](https://github.com/haskell/haskell-language-server/pull/2981)) by @kokobd+- Implement PluginMethod for hard-wired in handlers+([#2977](https://github.com/haskell/haskell-language-server/pull/2977)) by @fendor+- Set up partial functions ratchet+([#2974](https://github.com/haskell/haskell-language-server/pull/2974)) by @michaelpj+- Turn HLS-wrapper into an LSP Server+([#2960](https://github.com/haskell/haskell-language-server/pull/2960)) by @smatting+- More Fourmolu improvements+([#2959](https://github.com/haskell/haskell-language-server/pull/2959)) by @georgefst+- hls-class-plugin: Only create placeholders for unimplemented methods+([#2956](https://github.com/haskell/haskell-language-server/pull/2956)) by @akshaymankar+- Fix Fourmolu 0.7 support+([#2950](https://github.com/haskell/haskell-language-server/pull/2950)) by @georgefst+- Teach HLS about different file extensions+([#2945](https://github.com/haskell/haskell-language-server/pull/2945)) by @fendor+- Support `fourmolu ^>= 0.7`+([#2944](https://github.com/haskell/haskell-language-server/pull/2944)) by @parsonsmatt+- hls-explicit-fixity-plugin+([#2941](https://github.com/haskell/haskell-language-server/pull/2941)) by @July541+- chore(nix): bump nixpkgs to prevent glibc issues+([#2937](https://github.com/haskell/haskell-language-server/pull/2937)) by @teto+- Support ghc-9.2.3+([#2936](https://github.com/haskell/haskell-language-server/pull/2936)) by @July541+- Typo fix, dependecies -> dependencies+([#2934](https://github.com/haskell/haskell-language-server/pull/2934)) by @vikrem+- Update Archlinux installation section+([#2933](https://github.com/haskell/haskell-language-server/pull/2933)) by @marcin-rzeznicki+- docs/installation: Remove unused clone with submodule command+([#2930](https://github.com/haskell/haskell-language-server/pull/2930)) by @sloorush+- Omit more parens for wildcard type signature+([#2929](https://github.com/haskell/haskell-language-server/pull/2929)) by @sergv+- Add `throwPluginError` to Plugin Utilities+([#2924](https://github.com/haskell/haskell-language-server/pull/2924)) by @drsooch+- hls-class-plugin enhancement+([#2920](https://github.com/haskell/haskell-language-server/pull/2920)) by @July541+- Bump documentation requirements+([#2918](https://github.com/haskell/haskell-language-server/pull/2918)) by @xsebek+- Document eval plugin limitations+([#2917](https://github.com/haskell/haskell-language-server/pull/2917)) by @xsebek+- Replace TextDocumentIdentifier with Uri in getNormalizedFilePath+([#2912](https://github.com/haskell/haskell-language-server/pull/2912)) by @July541+- Fix hover format+([#2911](https://github.com/haskell/haskell-language-server/pull/2911)) by @July541+- Fix multiline eval plugin padding+([#2910](https://github.com/haskell/haskell-language-server/pull/2910)) by @xsebek+- Stan integration #258+([#2908](https://github.com/haskell/haskell-language-server/pull/2908)) by @uhbif19+- A plugin for GADT syntax converter+([#2899](https://github.com/haskell/haskell-language-server/pull/2899)) by @July541+- Fix DisplayTHWarning error+([#2895](https://github.com/haskell/haskell-language-server/pull/2895)) by @pepeiborra+- Enable hls-eval-plugin test on ghc-9.2.2+([#2893](https://github.com/haskell/haskell-language-server/pull/2893)) by @July541+- nix update+([#2892](https://github.com/haskell/haskell-language-server/pull/2892)) by @michaelpj+- Build hls-alternate-number-format-plugin with stack.yaml+([#2891](https://github.com/haskell/haskell-language-server/pull/2891)) by @July541+- Modify ghcide requirements of hls-change-type-signature-plugin+([#2889](https://github.com/haskell/haskell-language-server/pull/2889)) by @July541+- Fix hls-call-hierarchy-plugin tests+([#2888](https://github.com/haskell/haskell-language-server/pull/2888)) by @July541+- Add .txt files as extra-source-files for hls-change-type-signature-plugin+([#2887](https://github.com/haskell/haskell-language-server/pull/2887)) by @cdepillabout+- Prefer Data.HashSet.member to Data.Foldable.elem+([#2886](https://github.com/haskell/haskell-language-server/pull/2886)) by @sergv+- no longer disable -dynamic in CI+([#2885](https://github.com/haskell/haskell-language-server/pull/2885)) by @pepeiborra+- hls-pragmas-plugin requires ghcide >= 1.7+([#2884](https://github.com/haskell/haskell-language-server/pull/2884)) by @Bodigrim+- Make iface-error-test-1 less flaky+([#2882](https://github.com/haskell/haskell-language-server/pull/2882)) by @pepeiborra+- hls-haddock-comments does not support ghc-exactprint >= 1.0+([#2878](https://github.com/haskell/haskell-language-server/pull/2878)) by @Bodigrim+- Restore compat. with prettyprinter 1.6+([#2877](https://github.com/haskell/haskell-language-server/pull/2877)) by @pepeiborra+- ghcide requires ghc-exactprint >= 1.4+([#2876](https://github.com/haskell/haskell-language-server/pull/2876)) by @Bodigrim+- ghcide needs prettyprinter-1.7 to build+([#2875](https://github.com/haskell/haskell-language-server/pull/2875)) by @juhp+- Review project stack descriptors according to #2533+([#2874](https://github.com/haskell/haskell-language-server/pull/2874)) by @pepeiborra+- hls-call-hierarchy-plugin Patch release+([#2873](https://github.com/haskell/haskell-language-server/pull/2873)) by @pepeiborra+- Expand input to pragma if available+([#2871](https://github.com/haskell/haskell-language-server/pull/2871)) by @July541+- Fix hanging redundant import on Unicode function +([#2870](https://github.com/haskell/haskell-language-server/pull/2870)) by @drsooch+- Compatibility with older aeson releases+([#2868](https://github.com/haskell/haskell-language-server/pull/2868)) by @pepeiborra+- simplify hlint plugin Cabal descriptor+([#2867](https://github.com/haskell/haskell-language-server/pull/2867)) by @pepeiborra+- Consolidate all cabal.project files+([#2866](https://github.com/haskell/haskell-language-server/pull/2866)) by @pepeiborra+- release script fixes+([#2861](https://github.com/haskell/haskell-language-server/pull/2861)) by @wz1000+- Support hls-hlint-plugin and hls-stylish-plugin for ghc9.0 and ghc9.2+([#2854](https://github.com/haskell/haskell-language-server/pull/2854)) by @July541+- Bump haskell/actions from 1 to 2+([#2852](https://github.com/haskell/haskell-language-server/pull/2852)) by @dependabot[bot]+- Add scripts for releases and final 1.7 tweaks+([#2850](https://github.com/haskell/haskell-language-server/pull/2850)) by @wz1000+- Fix Completion document format+([#2848](https://github.com/haskell/haskell-language-server/pull/2848)) by @July541+- Improve name export code action+([#2847](https://github.com/haskell/haskell-language-server/pull/2847)) by @sergv+- Update plugin support table+([#2840](https://github.com/haskell/haskell-language-server/pull/2840)) by @michaelpj+- Unify showSDocUnsafe+([#2830](https://github.com/haskell/haskell-language-server/pull/2830)) by @July541+- ghcide: remove redundant env NIX_GHC_LIBDIR+([#2819](https://github.com/haskell/haskell-language-server/pull/2819)) by @sloorush+- Serialize Core+([#2813](https://github.com/haskell/haskell-language-server/pull/2813)) by @wz1000+- Expose runtime metrics via EKG+([#2267](https://github.com/haskell/haskell-language-server/pull/2267)) by @pepeiborra+ ## 1.7.0.0 - Distribute dynamically linked binaries for HLS to avoid statically linking against GLIBC
README.md view
@@ -30,6 +30,7 @@ - [Features](https://haskell-language-server.readthedocs.io/en/latest/features.html) - [Installation](https://haskell-language-server.readthedocs.io/en/latest/installation.html)+- [Supported GHC Versions](https://haskell-language-server.readthedocs.io/en/latest/supported-versions.html) - [Configuration](https://haskell-language-server.readthedocs.io/en/latest/configuration.html) - [Troubleshooting](https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html) - [Contributing](https://haskell-language-server.readthedocs.io/en/latest/contributing/index.html)
+ bench/Main.hs view
@@ -0,0 +1,282 @@++{- Bench history++ A Shake script to analyze the performance of HLS over the git history of the project++ Driven by a config file `bench/config.yaml` containing the list of Git references to analyze.++ Builds each one of them and executes a set of experiments using the ghcide-bench suite.++ The results of the benchmarks and the analysis are recorded in the file+ system with the following structure:++ bench-results+ ├── <git-reference>+ │ ├── ghc.path - path to ghc used to build the binary+ │ └── haskell-language-server - binary for this version+ ├─ <example>+ │ ├── results.csv - aggregated results for all the versions+ │ └── <git-reference>+ | └── <HLS plugin>+ │ ├── <experiment>.gcStats.log - RTS -s output+ │ ├── <experiment>.csv - stats for the experiment+ │ ├── <experiment>.svg - Graph of bytes over elapsed time+ │ ├── <experiment>.diff.svg - idem, including the previous version+ │ ├── <experiment>.log - ghcide-bench output+ │ └── results.csv - results of all the experiments for the example+ ├── results.csv - aggregated results of all the experiments and versions+ └── <experiment>.svg - graph of bytes over elapsed time, for all the included versions++ For diff graphs, the "previous version" is the preceding entry in the list of versions+ in the config file. A possible improvement is to obtain this info via `git rev-list`.++ To execute the script:++ > cabal/stack bench++ To build a specific analysis, enumerate the desired file artifacts++ > stack bench --ba "bench-results/HEAD/results.csv bench-results/HEAD/edit.diff.svg"+ > cabal bench --benchmark-options "bench-results/HEAD/results.csv bench-results/HEAD/edit.diff.svg"++ -}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS -Wno-orphans #-}+{-# LANGUAGE PackageImports #-}++import Control.Lens (preview, (^.))+import Control.Monad.Extra+import Data.Aeson (Value (..), encode)+import Data.Aeson.Lens+import Data.Default+import Data.Foldable (find)+import qualified Data.Map.Strict as Map+import Data.Maybe+import Data.Text (pack, unpack)+import Data.Yaml (FromJSON (..), ToJSON (toJSON),+ decodeFileThrow)+import Development.Benchmark.Rules hiding (parallelism)+import Development.Shake (Action,+ Change (ChangeModtimeAndDigestInput),+ CmdOption (Cwd, StdinBS),+ RuleResult, Rules,+ ShakeOptions (shakeChange, shakeThreads),+ actionBracket, addOracle,+ askOracle, command, command_,+ getDirectoryFiles, liftIO, need,+ newCache, shakeArgsWith,+ shakeOptions, versioned, want)+import Development.Shake.Classes+import Experiments.Types (Example (exampleName),+ exampleToOptions)+import GHC.Exts (toList)+import GHC.Generics (Generic)+import HlsPlugins (idePlugins)+import qualified Ide.Plugin.Config as Plugin+import Ide.Types+import Numeric.Natural (Natural)+import System.Console.GetOpt+import System.Directory+import System.FilePath+import System.IO.Error (tryIOError)++configPath :: FilePath+configPath = "bench/config.yaml"++configOpt :: OptDescr (Either String FilePath)+configOpt = Option [] ["config"] (ReqArg Right configPath) "config file"++binaryName :: String+binaryName = "haskell-language-server"++-- | Read the config without dependency+readConfigIO :: FilePath -> IO (Config BuildSystem)+readConfigIO = decodeFileThrow++instance IsExample Example where getExampleName = exampleName+type instance RuleResult GetExample = Maybe Example+type instance RuleResult GetExamples = [Example]++shakeOpts :: ShakeOptions+shakeOpts =+ shakeOptions{shakeChange = ChangeModtimeAndDigestInput, shakeThreads = 0}++main :: IO ()+main = shakeArgsWith shakeOpts [configOpt] $ \configs wants -> pure $ Just $ do+ let config = fromMaybe configPath $ listToMaybe configs+ _configStatic <- createBuildSystem config+ case wants of+ [] -> want ["all"]+ _ -> want wants++hlsBuildRules :: MkBuildRules BuildSystem+hlsBuildRules = MkBuildRules findGhcForBuildSystem binaryName projectDepends buildHls+ where+ recordDepends path =+ need . map (path </>) =<< getDirectoryFiles path ["//*.hs"]+ projectDepends = do+ recordDepends "src"+ recordDepends "exe"+ recordDepends "plugins"+ recordDepends "ghcide/session-loader"+ recordDepends "ghcide/src"+ recordDepends "hls-graph/src"+ recordDepends "hls-plugin-api/src"+ need =<< getDirectoryFiles "." ["*.cabal"]++--------------------------------------------------------------------------------+data Config buildSystem = Config+ { experiments :: [Unescaped String],+ configurations :: [ConfigurationDescriptor],+ examples :: [Example],+ samples :: Natural,+ versions :: [GitCommit],+ -- | Output folder ('foo' works, 'foo/bar' does not)+ outputFolder :: String,+ buildTool :: buildSystem,+ profileInterval :: Maybe Double,+ parallelism :: Natural+ }+ deriving (Generic, Show)+ deriving anyclass (FromJSON)++createBuildSystem :: FilePath -> Rules (Config BuildSystem)+createBuildSystem config = do+ readConfig <- newCache $ \fp -> need [fp] >> liftIO (readConfigIO fp)++ _ <- addOracle $ \GetExperiments {} -> experiments <$> readConfig config+ _ <- addOracle $ \GetVersions {} -> versions <$> readConfig config+ _ <- versioned 1 $ addOracle $ \GetExamples{} -> examples <$> readConfig config+ _ <- versioned 1 $ addOracle $ \(GetExample name) -> find (\e -> getExampleName e == name) . examples <$> readConfig config+ _ <- addOracle $ \GetBuildSystem {} -> buildTool <$> readConfig config+ _ <- addOracle $ \GetSamples{} -> samples <$> readConfig config+ _ <- addOracle $ \GetConfigurations{} -> do+ Config{configurations} <- readConfig config+ return [ Configuration confName (encode $ disableAllPluginsBut (`elem` confPlugins))+ | ConfigurationDescriptor{..} <- configurations+ ]++ configStatic <- liftIO $ readConfigIO config+ let build = outputFolder configStatic++ buildRules build hlsBuildRules+ benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchHls warmupHls "haskell-language-server" (parallelism configStatic))+ csvRules build+ svgRules build+ heapProfileRules build+ phonyRules "" binaryName NoProfiling build (examples configStatic)++ whenJust (profileInterval configStatic) $ \i -> do+ phonyRules "profiled-" binaryName (CheapHeapProfiling i) build (examples configStatic)++ return configStatic++disableAllPluginsBut :: (PluginId -> Bool) -> Plugin.Config+disableAllPluginsBut pred = def {Plugin.plugins = pluginsMap} where+ pluginsMap = Map.fromList+ [ (p, def { Plugin.plcGlobalOn = globalOn})+ | PluginDescriptor{pluginId = plugin@(PluginId p)} <- plugins+ , let globalOn =+ -- ghcide-core is required, nothing works without it+ plugin == PluginId (pack "ghcide-core")+ -- document symbols is required by the benchmark suite+ || plugin == PluginId (pack "ghcide-hover-and-symbols")+ || pred plugin+ ]+ IdePlugins plugins = idePlugins mempty++newtype GetSamples = GetSamples () deriving newtype (Binary, Eq, Hashable, NFData, Show)+type instance RuleResult GetSamples = Natural++--------------------------------------------------------------------------------++buildHls :: BuildSystem -> ProjectRoot -> OutputFolder -> Action ()+buildHls Cabal root out = actionBracket+ (do+ projectLocalExists <- liftIO $ doesFileExist projectLocal+ when projectLocalExists $ liftIO $ do+ void $ tryIOError $ removeFile (projectLocal <.> "restore-after-benchmark")+ renameFile projectLocal (projectLocal <.> "restore-after-benchmark")+ liftIO $ writeFile projectLocal $ unlines+ ["package haskell-language-server"+ ," ghc-options: -eventlog -rtsopts"+ ,"package ghcide"+ ," flags: +ekg"+ ]+ return projectLocalExists)+ (\projectLocalExists -> do+ removeFile projectLocal+ when projectLocalExists $+ renameFile (projectLocal <.> "restore-after-benchmark") projectLocal+ ) $ \_ -> command_ [Cwd root] "cabal"+ ["install"+ ,"haskell-language-server:exe:haskell-language-server"+ ,"--installdir=" ++ out+ ,"--install-method=copy"+ ,"--overwrite-policy=always"+ ]+ where+ projectLocal = root </> "cabal.project.local"++buildHls Stack root out =+ command_ [Cwd root] "stack"+ ["--local-bin-path=" <> out+ ,"build"+ ,"haskell-language-server:haskell-language-server"+ ,"--copy-bins"+ ,"--ghc-options=-rtsopts"+ ,"--ghc-options=-eventlog"+ ]++benchHls+ :: Natural -> BuildSystem -> [CmdOption] -> BenchProject Example -> Action ()+benchHls samples buildSystem args BenchProject{..} = do+ command_ ([StdinBS configuration] ++ args) "ghcide-bench" $+ [ "--timeout=300",+ "--no-clean",+ "-v",+ "--samples=" <> show samples,+ "--csv=" <> outcsv,+ "--ghcide=" <> exePath,+ "--select",+ unescaped (unescapeExperiment experiment),+ "--lsp-config"+ ] +++ exampleToOptions example exeExtraArgs +++ [ "--stack" | Stack == buildSystem+ ]++warmupHls :: BuildSystem -> FilePath -> [CmdOption] -> Example -> Action ()+warmupHls buildSystem exePath args example = do+ command args "ghcide-bench" $+ [ "--no-clean",+ "-v",+ "--samples=1",+ "--ghcide=" <> exePath,+ "--select=hover"+ ] +++ exampleToOptions example [] +++ [ "--stack" | Stack == buildSystem+ ]++--------------------------------------------------------------------------------+data ConfigurationDescriptor = ConfigurationDescriptor+ { confName :: String+ , confPlugins :: [PluginId]+ }+ deriving Show++instance FromJSON ConfigurationDescriptor where+ parseJSON (String s) = pure $ ConfigurationDescriptor (unpack s) [PluginId s]+ parseJSON o@Object{} = do+ let keymap = o ^. _Object+ matchKey = preview _String . toJSON+ case toList keymap of+ -- excuse the aeson 2.0 compatibility hack+ [(matchKey -> Just name, Array values)] -> do+ pluginIds <- traverse parseJSON values+ pure $ ConfigurationDescriptor (unpack name) (map PluginId $ toList pluginIds)+ other -> fail $ "Expected object with name and array of plugin ids: " <> show other+ parseJSON _ = fail "Expected plugin id or object with name and array of plugin ids"
exe/Main.hs view
@@ -1,29 +1,42 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Main(main) where +import Control.Arrow ((&&&)) import Control.Monad.IO.Class (liftIO) import Data.Function ((&))-import Data.Text (Text)-import qualified Development.IDE.Types.Logger as Logger-import Development.IDE.Types.Logger (Priority (Debug, Info, Error),+import Data.Text (Text)+import qualified Development.IDE.Main as GhcideMain+import Development.IDE.Types.Logger (Doc,+ Priority (Debug, Error, Info), WithPriority (WithPriority, priority), cfilter, cmapWithPrio,+ defaultLayoutOptions,+ layoutPretty, makeDefaultStderrRecorder,- withDefaultRecorder, renderStrict, layoutPretty, defaultLayoutOptions, Doc)+ payload, renderStrict,+ withDefaultRecorder)+import qualified Development.IDE.Types.Logger as Logger+import qualified HlsPlugins as Plugins import Ide.Arguments (Arguments (..), GhcideArguments (..), getArguments) import Ide.Main (defaultMain) import qualified Ide.Main as IdeMain import Ide.PluginUtils (pluginDescToIdePlugins)-import Ide.Types (PluginDescriptor (pluginNotificationHandlers), defaultPluginDescriptor, mkPluginNotificationHandler)+import Ide.Types (PluginDescriptor (pluginNotificationHandlers),+ defaultPluginDescriptor,+ mkPluginNotificationHandler) import Language.LSP.Server as LSP import Language.LSP.Types as LSP-import qualified Plugins+#if MIN_VERSION_prettyprinter(1,7,0) import Prettyprinter (Pretty (pretty), vsep)+#else+import Data.Text.Prettyprint.Doc (Pretty (pretty), vsep)+#endif data Log = LogIdeMain IdeMain.Log@@ -39,7 +52,7 @@ -- plugin cli commands use stderr logger for now unless we change the args -- parser to get logging arguments first or do more complicated things pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing Info- args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder) False)+ args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder)) (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder@@ -51,26 +64,30 @@ liftIO $ (cb1 <> cb2) env } - let (minPriority, logFilePath, includeExamplePlugins) =+ let (argsTesting, minPriority, logFilePath) = case args of- Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile, argsExamplePlugin } ->+ Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile} -> let minPriority = if argsDebugOn || argsTesting then Debug else Info- in (minPriority, argsLogFile, argsExamplePlugin)- _ -> (Info, Nothing, False)+ in (argsTesting, minPriority, argsLogFile)+ _ -> (False, Info, Nothing) withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do let- recorder = cmapWithPrio pretty $ mconcat+ recorder = cmapWithPrio (pretty &&& id) $ mconcat [textWithPriorityRecorder & cfilter (\WithPriority{ priority } -> priority >= minPriority)+ & cmapWithPrio fst , lspMessageRecorder & cfilter (\WithPriority{ priority } -> priority >= Error)- & cmapWithPrio renderDoc+ & cmapWithPrio (renderDoc . fst) , lspLogRecorder & cfilter (\WithPriority{ priority } -> priority >= minPriority)- & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)+ & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions . fst)+ -- do not log heap stats to the LSP log as they interfere with the+ -- ability of lsp-test to detect a stuck server in tests and benchmarks+ & if argsTesting then cfilter (not . heapStats . snd . payload) else id ]- plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder) includeExamplePlugins)+ plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder)) defaultMain (cmapWithPrio LogIdeMain recorder)@@ -85,3 +102,7 @@ issueTrackerUrl :: Doc a issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"++heapStats :: Log -> Bool+heapStats (LogIdeMain (IdeMain.LogIDEMain (GhcideMain.LogHeapStats _))) = True+heapStats _ = False
− exe/Plugins.hs
@@ -1,200 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}-module Plugins where--import Development.IDE.Types.Logger (Pretty (pretty), Recorder,- WithPriority, cmapWithPrio)-import Ide.PluginUtils (pluginDescToIdePlugins)-import Ide.Types (IdePlugins)---- fixed plugins-import Development.IDE (IdeState)-import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde-import qualified Ide.Plugin.Example as Example-import qualified Ide.Plugin.Example2 as Example2---- haskell-language-server optional plugins-#if qualifyImportedNames-import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames-#endif--#if callHierarchy-import qualified Ide.Plugin.CallHierarchy as CallHierarchy-#endif--#if class-import qualified Ide.Plugin.Class as Class-#endif--#if haddockComments-import qualified Ide.Plugin.HaddockComments as HaddockComments-#endif--#if eval-import qualified Ide.Plugin.Eval as Eval-#endif--#if importLens-import qualified Ide.Plugin.ExplicitImports as ExplicitImports-#endif--#if refineImports-import qualified Ide.Plugin.RefineImports as RefineImports-#endif--#if rename-import qualified Ide.Plugin.Rename as Rename-#endif--#if retrie-import qualified Ide.Plugin.Retrie as Retrie-#endif--#if tactic-import qualified Ide.Plugin.Tactic as Tactic-#endif--#if hlint-import qualified Ide.Plugin.Hlint as Hlint-#endif--#if moduleName-import qualified Ide.Plugin.ModuleName as ModuleName-#endif--#if pragmas-import qualified Ide.Plugin.Pragmas as Pragmas-#endif--#if splice-import qualified Ide.Plugin.Splice as Splice-#endif--#if alternateNumberFormat-import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat-#endif--#if selectionRange-import Ide.Plugin.SelectionRange as SelectionRange-#endif--#if changeTypeSignature-import Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature-#endif--- formatters--#if floskell-import qualified Ide.Plugin.Floskell as Floskell-#endif--#if fourmolu-import qualified Ide.Plugin.Fourmolu as Fourmolu-#endif--#if ormolu-import qualified Ide.Plugin.Ormolu as Ormolu-#endif--#if stylishHaskell-import qualified Ide.Plugin.StylishHaskell as StylishHaskell-#endif--#if brittany-import qualified Ide.Plugin.Brittany as Brittany-#endif--data Log = forall a. (Pretty a) => Log a--instance Pretty Log where- pretty (Log a) = pretty a---- ------------------------------------------------------------------------- | The plugins configured for use in this instance of the language--- server.--- These can be freely added or removed to tailor the available--- features of the server.--idePlugins :: Recorder (WithPriority Log) -> Bool -> IdePlugins IdeState-idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins- where- pluginRecorder :: forall log. (Pretty log) => Recorder (WithPriority log)- pluginRecorder = cmapWithPrio Log recorder- allPlugins = if includeExamples- then basePlugins ++ examplePlugins- else basePlugins- basePlugins =-#if pragmas- Pragmas.descriptor "pragmas" :-#endif-#if floskell- Floskell.descriptor "floskell" :-#endif-#if fourmolu- Fourmolu.descriptor "fourmolu" :-#endif-#if tactic- Tactic.descriptor pluginRecorder "tactics" :-#endif-#if ormolu- Ormolu.descriptor "ormolu" :-#endif-#if stylishHaskell- StylishHaskell.descriptor "stylish-haskell" :-#endif-#if rename- Rename.descriptor "rename" :-#endif-#if retrie- Retrie.descriptor "retrie" :-#endif-#if brittany- Brittany.descriptor "brittany" :-#endif-#if callHierarchy- CallHierarchy.descriptor "callHierarchy":-#endif-#if class- Class.descriptor "class" :-#endif-#if haddockComments- HaddockComments.descriptor "haddockComments" :-#endif-#if eval- Eval.descriptor pluginRecorder "eval" :-#endif-#if importLens- ExplicitImports.descriptor pluginRecorder "importLens" :-#endif-#if qualifyImportedNames- QualifyImportedNames.descriptor "qualifyImportedNames" :-#endif-#if refineImports- RefineImports.descriptor pluginRecorder "refineImports" :-#endif-#if moduleName- ModuleName.descriptor "moduleName" :-#endif-#if hlint- Hlint.descriptor pluginRecorder "hlint" :-#endif-#if splice- Splice.descriptor "splice" :-#endif-#if alternateNumberFormat- AlternateNumberFormat.descriptor pluginRecorder "alternateNumberFormat" :-#endif-#if selectionRange- SelectionRange.descriptor "selectionRange" :-#endif-#if changeTypeSignature- ChangeTypeSignature.descriptor "changeTypeSignature" :-#endif- -- The ghcide descriptors should come last so that the notification handlers- -- (which restart the Shake build) run after everything else- GhcIde.descriptors pluginRecorder- examplePlugins =- [Example.descriptor pluginRecorder "eg"- ,Example2.descriptor pluginRecorder "eg2"- ]
exe/Wrapper.hs view
@@ -1,18 +1,25 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | This module is based on the hie-wrapper.sh script in -- https://github.com/alanz/vscode-hie-server module Main where import Control.Monad.Extra-import Data.Char (isSpace)+import Data.Char (isSpace) import Data.Default+import Data.Either.Extra (eitherToMaybe) import Data.Foldable import Data.List import Data.Void-import qualified Development.IDE.Session as Session-import qualified HIE.Bios.Environment as HieBios+import qualified Development.IDE.Session as Session+import qualified HIE.Bios.Environment as HieBios import HIE.Bios.Types import Ide.Arguments import Ide.Version@@ -20,14 +27,42 @@ import System.Environment import System.Exit import System.FilePath-import System.IO import System.Info+import System.IO #ifndef mingw32_HOST_OS-import System.Posix.Process (executeFile)-import qualified Data.Map.Strict as Map+import qualified Data.Map.Strict as Map+import System.Posix.Process (executeFile) #else import System.Process #endif+import Control.Concurrent (tryPutMVar)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Control.Monad.Trans.Except (ExceptT, runExceptT,+ throwE)+import Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Development.IDE.LSP.LanguageServer (runLanguageServer)+import qualified Development.IDE.Main as Main+import Development.IDE.Types.Logger (Logger (Logger),+ Pretty (pretty),+ Priority (Info),+ Recorder (logger_),+ WithPriority (WithPriority),+ cmapWithPrio,+ makeDefaultStderrRecorder)+import GHC.Stack.Types (emptyCallStack)+import Ide.Plugin.Config (Config)+import Language.LSP.Server (LspM)+import qualified Language.LSP.Server as LSP+import Language.LSP.Types (MessageActionItem (MessageActionItem),+ MessageType (MtError),+ Method (Initialize),+ RequestMessage,+ ResponseError,+ SMethod (SExit, SWindowShowMessageRequest),+ ShowMessageRequestParams (ShowMessageRequestParams)) -- --------------------------------------------------------------------- @@ -44,6 +79,10 @@ putStrLn hlsVer putStrLn "Tool versions found on the $PATH" putStrLn $ showProgramVersionOfInterest programsOfInterest+ putStrLn "Tool versions in your project"+ cradle <- findProjectCradle' False+ ghcVersion <- runExceptT $ getRuntimeGhcVersion' cradle+ putStrLn $ showProgramVersion "ghc" $ mkVersion =<< eitherToMaybe ghcVersion VersionMode PrintVersion -> putStrLn hlsVer@@ -57,9 +96,15 @@ cradle <- findProjectCradle' False (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir cradle putStr libdir- _ -> launchHaskellLanguageServer args+ _ -> launchHaskellLanguageServer args >>= \case+ Right () -> pure ()+ Left err -> do+ T.hPutStrLn stderr (prettyError err NoShorten)+ case args of+ Ghcide _ -> launchErrorLSP (prettyError err Shorten)+ _ -> pure () -launchHaskellLanguageServer :: Arguments -> IO ()+launchHaskellLanguageServer :: Arguments -> IO (Either WrapperSetupError ()) launchHaskellLanguageServer parsedArgs = do case parsedArgs of Ghcide GhcideArguments{..} -> whenJust argsCwd setCurrentDirectory@@ -75,7 +120,10 @@ case parsedArgs of Ghcide GhcideArguments{..} ->- when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess+ when argsProjectGhcVersion $ do+ runExceptT (getRuntimeGhcVersion' cradle) >>= \case+ Right ghcVersion -> putStrLn ghcVersion >> exitSuccess+ Left err -> T.putStrLn (prettyError err NoShorten) >> exitFailure _ -> pure () progName <- getProgName@@ -94,64 +142,74 @@ hPutStrLn stderr "" -- Get the ghc version -- this might fail! hPutStrLn stderr "Consulting the cradle to get project GHC version..."- ghcVersion <- getRuntimeGhcVersion' cradle- hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion - let- hlsBin = "haskell-language-server-" ++ ghcVersion- candidates' = [hlsBin, "haskell-language-server"]- candidates = map (++ exeExtension) candidates'+ runExceptT $ do+ ghcVersion <- getRuntimeGhcVersion' cradle+ liftIO $ hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion - hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates+ let+ hlsBin = "haskell-language-server-" ++ ghcVersion+ candidates' = [hlsBin, "haskell-language-server"]+ candidates = map (++ exeExtension) candidates' - mexes <- traverse findExecutable candidates+ liftIO $ hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates - case asum mexes of- Nothing -> die $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates- Just e -> do- hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e+ mexes <- liftIO $ traverse findExecutable candidates++ case asum mexes of+ Nothing -> throwE (NoLanguageServer ghcVersion candidates)+ Just e -> do+ liftIO $ hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e+ #ifdef mingw32_HOST_OS- callProcess e args+ liftIO $ callProcess e args #else- let Cradle { cradleOptsProg = CradleAction { runGhcCmd } } = cradle- -- we need to be compatible with NoImplicitPrelude- ghcBinary <- (fmap trim <$> runGhcCmd ["-v0", "-package-env=-", "-ignore-dot-ghci", "-e", "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"])- >>= cradleResult "Failed to get project GHC executable path"- libdir <- HieBios.getRuntimeGhcLibDir cradle- >>= cradleResult "Failed to get project GHC libdir path"- env <- Map.fromList <$> getEnvironment- let newEnv = Map.insert "GHC_BIN" ghcBinary $ Map.insert "GHC_LIBDIR" libdir env- executeFile e True args (Just (Map.toList newEnv))++ let Cradle { cradleOptsProg = CradleAction { runGhcCmd } } = cradle++ let cradleName = actionName (cradleOptsProg cradle)+ -- we need to be compatible with NoImplicitPrelude+ ghcBinary <- liftIO (fmap trim <$> runGhcCmd ["-v0", "-package-env=-", "-ignore-dot-ghci", "-e", "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"])+ >>= cradleResult cradleName++ libdir <- liftIO (HieBios.getRuntimeGhcLibDir cradle)+ >>= cradleResult cradleName++ env <- Map.fromList <$> liftIO getEnvironment+ let newEnv = Map.insert "GHC_BIN" ghcBinary $ Map.insert "GHC_LIBDIR" libdir env+ liftIO $ executeFile e True args (Just (Map.toList newEnv)) #endif -cradleResult :: String -> CradleLoadResult a -> IO a-cradleResult _ (CradleSuccess a) = pure a-cradleResult str (CradleFail e) = die $ str ++ ": " ++ show e-cradleResult str CradleNone = die $ str ++ ": no cradle" +cradleResult :: ActionName Void -> CradleLoadResult a -> ExceptT WrapperSetupError IO a+cradleResult _ (CradleSuccess ver) = pure ver+cradleResult cradleName (CradleFail error) = throwE $ FailedToObtainGhcVersion cradleName error+cradleResult cradleName CradleNone = throwE $ NoneCradleGhcVersion cradleName+ -- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also -- checks to see if the tool is missing if it is one of-getRuntimeGhcVersion' :: Show a => Cradle a -> IO String+getRuntimeGhcVersion' :: Cradle Void -> ExceptT WrapperSetupError IO String getRuntimeGhcVersion' cradle = do+ let cradleName = actionName (cradleOptsProg cradle) -- See if the tool is installed- case actionName (cradleOptsProg cradle) of+ case cradleName of Stack -> checkToolExists "stack" Cabal -> checkToolExists "cabal" Default -> checkToolExists "ghc" Direct -> checkToolExists "ghc" _ -> pure () - HieBios.getRuntimeGhcVersion cradle >>= cradleResult "Failed to get project GHC version"+ ghcVersionRes <- liftIO $ HieBios.getRuntimeGhcVersion cradle+ cradleResult cradleName ghcVersionRes+ where checkToolExists exe = do- exists <- findExecutable exe+ exists <- liftIO $ findExecutable exe case exists of Just _ -> pure ()- Nothing ->- die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n"- ++ show cradle+ Nothing -> throwE $ ToolRequirementMissing exe (actionName (cradleOptsProg cradle)) findProjectCradle :: IO (Cradle Void) findProjectCradle = findProjectCradle' True@@ -175,3 +233,85 @@ trim s = case lines s of [] -> s ls -> dropWhileEnd isSpace $ last ls++data WrapperSetupError+ = FailedToObtainGhcVersion (ActionName Void) CradleError+ | NoneCradleGhcVersion (ActionName Void)+ | NoLanguageServer String [FilePath]+ | ToolRequirementMissing String (ActionName Void)+ deriving (Show)++data Shorten = Shorten | NoShorten++-- | Pretty error message displayable to the future.+-- Extra argument 'Shorten' can be used to shorten error message.+-- Reduces usefulness, but allows us to show the error message via LSP+-- as LSP doesn't allow any newlines and makes it really hard to read+-- the message otherwise.+prettyError :: WrapperSetupError -> Shorten -> T.Text+prettyError (FailedToObtainGhcVersion name crdlError) shorten =+ "Failed to find the GHC version of this " <> T.pack (show name) <> " project." <>+ case shorten of+ Shorten ->+ "\n" <> T.pack (fromMaybe "" . listToMaybe $ cradleErrorStderr crdlError)+ NoShorten ->+ "\n" <> T.pack (intercalate "\n" (cradleErrorStderr crdlError))+prettyError (NoneCradleGhcVersion name) _ =+ "Failed to get the GHC version of this " <> T.pack (show name) <>+ " project because a none cradle is configured"+prettyError (NoLanguageServer ghcVersion candidates) _ =+ "Failed to find a HLS version for GHC " <> T.pack ghcVersion <>+ "\nExecutable names we failed to find: " <> T.pack (intercalate "," candidates)+prettyError (ToolRequirementMissing toolExe name) _ =+ "Failed to find executable \"" <> T.pack toolExe <> "\" in $PATH for this " <> T.pack (show name) <> " project."++newtype ErrorLSPM c a = ErrorLSPM { unErrorLSPM :: (LspM c) a }+ deriving (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, LSP.MonadLsp c)++-- | Launches a LSP that displays an error and presents the user with a request+-- to shut down the LSP.+launchErrorLSP :: T.Text -> IO ()+launchErrorLSP errorMsg = do+ recorder <- makeDefaultStderrRecorder Nothing Info++ let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack (pretty m))++ let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) logger++ inH <- Main.argsHandleIn defaultArguments++ outH <- Main.argsHandleOut defaultArguments++ let onConfigurationChange cfg _ = Right cfg++ let setup clientMsgVar = do+ -- Forcefully exit+ let exit = void $ tryPutMVar clientMsgVar ()++ let doInitialize :: LSP.LanguageContextEnv Config -> RequestMessage Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv Config, ()))+ doInitialize env _ = do++ let restartTitle = "Try to restart"+ void $ LSP.runLspT env $ LSP.sendRequest SWindowShowMessageRequest (ShowMessageRequestParams MtError errorMsg (Just [MessageActionItem restartTitle])) $ \case+ Right (Just (MessageActionItem title))+ | title == restartTitle -> liftIO exit+ _ -> pure ()++ pure (Right (env, ()))++ let asyncHandlers = mconcat+ [ exitHandler exit ]++ let interpretHandler (env, _st) = LSP.Iso (LSP.runLspT env . unErrorLSPM) liftIO+ pure (doInitialize, asyncHandlers, interpretHandler)++ runLanguageServer (cmapWithPrio pretty recorder)+ (Main.argsLspOptions defaultArguments)+ inH+ outH+ (Main.argsDefaultHlsConfig defaultArguments)+ onConfigurationChange+ setup++exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c)+exitHandler exit = LSP.notificationHandler SExit $ const $ liftIO exit
haskell-language-server.cabal view
@@ -1,7 +1,7 @@-cabal-version: 2.4+cabal-version: 3.0 category: Development name: haskell-language-server-version: 1.7.0.0+version: 1.8.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -14,7 +14,7 @@ license: Apache-2.0 license-file: LICENSE build-type: Simple-tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.6 || == 8.10.7 || == 9.0.2 || == 9.2.2+tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.3 || == 9.2.4 extra-source-files: README.md ChangeLog.md@@ -50,45 +50,6 @@ if flag(pedantic) ghc-options: -Werror -library- import: common-deps- -- configuration- , warnings- , pedantic- exposed-modules:- Ide.Arguments- Ide.Main- Ide.Version-- other-modules: Paths_haskell_language_server- autogen-modules: Paths_haskell_language_server- hs-source-dirs: src- build-depends:- , async- , base16-bytestring- , bytestring- , containers- , cryptohash-sha1- , data-default- , ghc- , ghcide ^>=1.7- , githash- , lsp- , hie-bios- , hiedb- , hls-plugin-api ^>=1.4- , optparse-applicative- , optparse-simple- , process- , hls-graph- , safe-exceptions- , sqlite-simple- , unordered-containers- , aeson-pretty-- default-language: Haskell2010- default-extensions: DataKinds, TypeOperators- -- Plugin flags are designed for 'cabal install haskell-language-server': -- - Bulk flags should be default:False -- - Individual flags should be default:True@@ -151,6 +112,11 @@ default: True manual: True +flag stan+ description: Enable stan plugin+ default: True+ manual: True+ flag moduleName description: Enable moduleName plugin default: True@@ -176,8 +142,8 @@ default: True manual: True -flag selectionRange- description: Enable selectionRange plugin+flag codeRange+ description: Enable Code Range plugin default: True manual: True @@ -186,6 +152,16 @@ default: True manual: True +flag gadt+ description: Enable gadt plugin+ default: True+ manual: True++flag explicitFixity+ description: Enable explicitFixity plugin+ default: True+ manual: True+ -- formatters flag floskell@@ -213,161 +189,223 @@ default: True manual: True +flag refactor+ description: Enable refactor plugin+ default: True+ manual: True+ flag dynamic description: Build with the dyn rts default: True manual: True -common example-plugins- hs-source-dirs: plugins/default/src- other-modules: Ide.Plugin.Example,- Ide.Plugin.Example2- common class- if flag(class) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-class-plugin ^>= 1.0- cpp-options: -Dclass+ if flag(class) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-class-plugin ^>= 1.1+ cpp-options: -Dhls_class common callHierarchy if flag(callHierarchy)- build-depends: hls-call-hierarchy-plugin ^>= 1.0- cpp-options: -DcallHierarchy+ build-depends: hls-call-hierarchy-plugin ^>= 1.1+ cpp-options: -Dhls_callHierarchy common haddockComments- if flag(haddockComments)- build-depends: hls-haddock-comments-plugin ^>= 1.0- cpp-options: -DhaddockComments+ if flag(haddockComments) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-haddock-comments-plugin ^>= 1.1+ cpp-options: -Dhls_haddockComments common eval- if flag(eval)- build-depends: hls-eval-plugin ^>= 1.2- cpp-options: -Deval+ if flag(eval) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-eval-plugin ^>= 1.3+ cpp-options: -Dhls_eval common importLens if flag(importLens) build-depends: hls-explicit-imports-plugin ^>= 1.1- cpp-options: -DimportLens+ cpp-options: -Dhls_importLens common refineImports if flag(refineImports) build-depends: hls-refine-imports-plugin ^>=1.0- cpp-options: -DrefineImports+ cpp-options: -Dhls_refineImports common rename- if flag(rename)+ if flag(rename) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-rename-plugin ^>= 1.0- cpp-options: -Drename+ cpp-options: -Dhls_rename common retrie- if flag(retrie) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+ if flag(retrie) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-retrie-plugin ^>= 1.0- cpp-options: -Dretrie+ cpp-options: -Dhls_retrie common tactic- if flag(tactic) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-tactics-plugin >=1.2.0.0 && <1.7- cpp-options: -Dtactic+ if flag(tactic) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-tactics-plugin ^>= 1.7+ cpp-options: -Dhls_tactic common hlint- if flag(hlint) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-hlint-plugin ^>= 1.0- cpp-options: -Dhlint+ if flag(hlint) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-hlint-plugin ^>= 1.1+ cpp-options: -Dhls_hlint +common stan+ if flag(stan) && (impl(ghc >= 8.8) && impl(ghc < 9.0))+ build-depends: hls-stan-plugin ^>= 1.0+ cpp-options: -Dhls_stan+ common moduleName if flag(moduleName)- build-depends: hls-module-name-plugin ^>= 1.0- cpp-options: -DmoduleName+ build-depends: hls-module-name-plugin ^>= 1.1+ cpp-options: -Dhls_moduleName common pragmas if flag(pragmas) build-depends: hls-pragmas-plugin ^>= 1.0- cpp-options: -Dpragmas+ cpp-options: -Dhls_pragmas common splice if flag(splice) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-splice-plugin ^>=1.0.0.1- cpp-options: -Dsplice+ cpp-options: -Dhls_splice common alternateNumberFormat- if flag(alternateNumberFormat)- build-depends: hls-alternate-number-format-plugin ^>= 1.1- cpp-options: -DalternateNumberFormat+ if flag(alternateNumberFormat) + build-depends: hls-alternate-number-format-plugin ^>= 1.2+ cpp-options: -Dhls_alternateNumberFormat common qualifyImportedNames if flag(qualifyImportedNames) build-depends: hls-qualify-imported-names-plugin ^>=1.0- cpp-options: -DqualifyImportedNames+ cpp-options: -Dhls_qualifyImportedNames -common selectionRange- if flag(selectionRange)- build-depends: hls-selection-range-plugin ^>= 1.0- cpp-options: -DselectionRange+common codeRange+ if flag(codeRange)+ build-depends: hls-code-range-plugin ^>= 1.0+ cpp-options: -Dhls_codeRange common changeTypeSignature if flag(changeTypeSignature) build-depends: hls-change-type-signature-plugin ^>= 1.0- cpp-options: -DchangeTypeSignature+ cpp-options: -Dhls_changeTypeSignature +common gadt+ if flag(gadt) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-gadt-plugin ^>= 1.0+ cpp-options: -Dhls_gadt++common explicitFixity+ if flag(explicitFixity)+ build-depends: hls-explicit-fixity-plugin ^>= 1.0+ cpp-options: -DexplicitFixity+ -- formatters common floskell- if flag(floskell)+ if flag(floskell) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-floskell-plugin ^>= 1.0- cpp-options: -Dfloskell+ cpp-options: -Dhls_floskell common fourmolu- if flag(fourmolu)- build-depends: hls-fourmolu-plugin ^>= 1.0- cpp-options: -Dfourmolu+ if flag(fourmolu) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-fourmolu-plugin ^>= 1.1+ cpp-options: -Dhls_fourmolu common ormolu- if flag(ormolu)+ if flag(ormolu) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-ormolu-plugin ^>= 1.0- cpp-options: -Dormolu+ cpp-options: -Dhls_ormolu common stylishHaskell- if flag(stylishHaskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))+ if flag(stylishHaskell) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-stylish-haskell-plugin ^>= 1.0- cpp-options: -DstylishHaskell+ cpp-options: -Dhls_stylishHaskell common brittany if flag(brittany) && (impl(ghc < 9.0.2) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-brittany-plugin ^>= 1.0- cpp-options: -Dbrittany+ cpp-options: -Dhls_brittany -executable haskell-language-server- import: common-deps+common refactor+ if flag(refactor) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-refactor-plugin ^>= 1.0+ cpp-options: -Dhls_refactor++library+ import: common-deps -- configuration- , warnings- , pedantic- -- plugins- , example-plugins- , callHierarchy- , changeTypeSignature- , class- , haddockComments- , eval- , importLens- , refineImports- , rename- , retrie- , tactic- , hlint- , moduleName- , pragmas- , splice- , alternateNumberFormat- , qualifyImportedNames- , selectionRange- , floskell- , fourmolu- , ormolu- , stylishHaskell- , brittany+ , warnings+ , pedantic+ -- plugins+ , callHierarchy+ , changeTypeSignature+ , class+ , haddockComments+ , eval+ , importLens+ , refineImports+ , rename+ , retrie+ , tactic+ , hlint+ , stan+ , moduleName+ , pragmas+ , splice+ , alternateNumberFormat+ , qualifyImportedNames+ , codeRange+ , gadt+ , explicitFixity+ , floskell+ , fourmolu+ , ormolu+ , stylishHaskell+ , brittany+ , refactor + exposed-modules:+ Ide.Arguments+ Ide.Main+ Ide.Version+ HlsPlugins++ other-modules: Paths_haskell_language_server+ autogen-modules: Paths_haskell_language_server+ hs-source-dirs: src+ build-depends:+ , async+ , base16-bytestring+ , bytestring+ , containers+ , cryptohash-sha1+ , data-default+ , ghc+ , ghcide ^>=1.8+ , githash >=0.1.6.1+ , lsp+ , hie-bios+ , hiedb+ , hls-plugin-api ^>=1.5+ , optparse-applicative+ , optparse-simple+ , process+ , hls-graph+ , safe-exceptions+ , sqlite-simple+ , unordered-containers+ , aeson-pretty++ default-language: Haskell2010+ default-extensions: DataKinds, TypeOperators++executable haskell-language-server+ import: common-deps+ -- configuration+ , warnings+ , pedantic main-is: Main.hs hs-source-dirs: exe- other-modules: Plugins ghc-options: -threaded@@ -448,10 +486,17 @@ , ghcide , gitrev , haskell-language-server+ , hslogger , hie-bios+ , hls-plugin-api+ , lsp+ , lsp-types+ , mtl , optparse-applicative , optparse-simple , process+ , transformers+ , unliftio-core if !os(windows) build-depends: unix@@ -464,6 +509,7 @@ import: common-deps , warnings , pedantic+ , refactor type: exitcode-stdio-1.0 default-language: Haskell2010 build-tool-depends:@@ -477,7 +523,7 @@ , lens , lens-aeson , ghcide- , hls-test-utils ^>=1.3+ , hls-test-utils ^>=1.4 , lsp-types , aeson , hls-plugin-api@@ -513,14 +559,14 @@ -- Duplicating inclusion plugin conditions until tests are moved to their own packages if flag(eval)- cpp-options: -Deval+ cpp-options: -Dhls_eval -- formatters if flag(floskell) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- cpp-options: -Dfloskell+ cpp-options: -Dhls_floskell if flag(fourmolu)- cpp-options: -Dfourmolu+ cpp-options: -Dhls_fourmolu if flag(ormolu)- cpp-options: -Dormolu+ cpp-options: -Dhls_ormolu test-suite wrapper-test import: common-deps@@ -538,3 +584,47 @@ hs-source-dirs: test/wrapper main-is: Main.hs++benchmark benchmark+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ ghc-options: -Wall -Wno-name-shadowing -threaded+ main-is: Main.hs+ hs-source-dirs: bench+ build-tool-depends:+ ghcide-bench:ghcide-bench,+ hp2pretty:hp2pretty,+ implicit-hie:gen-hie+ default-extensions:+ BangPatterns+ DeriveFunctor+ DeriveGeneric+ FlexibleContexts+ GeneralizedNewtypeDeriving+ LambdaCase+ NamedFieldPuns+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeApplications+ ViewPatterns++ build-depends:+ aeson,+ base == 4.*,+ containers,+ data-default,+ directory,+ extra,+ filepath,+ ghcide-bench,+ haskell-language-server,+ hls-plugin-api,+ lens,+ lens-aeson,+ optparse-applicative,+ shake,+ shake-bench == 0.1.*,+ text,+ yaml
− plugins/default/src/Ide/Plugin/Example.hs
@@ -1,253 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}--module Ide.Plugin.Example- (- descriptor- , Log(..)- ) where--import Control.Concurrent.STM-import Control.DeepSeq (NFData)-import Control.Monad.IO.Class-import Control.Monad.Trans.Maybe-import Data.Aeson-import Data.Functor-import qualified Data.HashMap.Strict as Map-import Data.Hashable-import qualified Data.Text as T-import Data.Typeable-import Development.IDE as D-import Development.IDE.Core.Shake (getDiagnostics,- getHiddenDiagnostics)-import qualified Development.IDE.Core.Shake as Shake-import Development.IDE.GHC.Compat-import GHC.Generics-import Ide.PluginUtils-import Ide.Types-import Language.LSP.Server-import Language.LSP.Types-import Options.Applicative (ParserInfo, info)-import Text.Regex.TDFA.Text ()---- -----------------------------------------------------------------------newtype Log = LogShake Shake.Log deriving Show--instance Pretty Log where- pretty = \case- LogShake log -> pretty log--descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState-descriptor recorder plId = (defaultPluginDescriptor plId)- { pluginRules = exampleRules recorder- , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]- , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction- <> mkPluginHandler STextDocumentCodeLens codeLens- <> mkPluginHandler STextDocumentHover hover- <> mkPluginHandler STextDocumentDocumentSymbol symbols- <> mkPluginHandler STextDocumentCompletion completion- , pluginCli = Just exampleCli- }--exampleCli :: ParserInfo (IdeCommand IdeState)-exampleCli = info p mempty- where p = pure $ IdeCommand $ \_ideState -> putStrLn "hello HLS"---- -----------------------------------------------------------------------hover :: PluginMethodHandler IdeState TextDocumentHover-hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}--blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))-blah _ (Position line col)- = return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover 1\n"])---- ------------------------------------------------------------------------ Generating Diagnostics via rules--- -----------------------------------------------------------------------data Example = Example- deriving (Eq, Show, Typeable, Generic)-instance Hashable Example-instance NFData Example--type instance RuleResult Example = ()--exampleRules :: Recorder (WithPriority Log) -> Rules ()-exampleRules recorder = do- define (cmapWithPrio LogShake recorder) $ \Example file -> do- _pm <- getParsedModule file- let diag = mkDiag file "example" DsError (Range (Position 0 0) (Position 1 0)) "example diagnostic, hello world"- return ([diag], Just ())-- action $ do- files <- getFilesOfInterestUntracked- void $ uses Example $ Map.keys files--mkDiag :: NormalizedFilePath- -> DiagnosticSource- -> DiagnosticSeverity- -> Range- -> T.Text- -> FileDiagnostic-mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)- Diagnostic- { _range = loc- , _severity = Just sev- , _source = Just diagSource- , _message = msg- , _code = Nothing- , _tags = Nothing- , _relatedInformation = Nothing- }---- ------------------------------------------------------------------------ code actions--- ------------------------------------------------------------------------- | Generate code actions.-codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction-codeAction state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = liftIO $ do- let mbnfp = uriToNormalizedFilePath $ toNormalizedUri uri- case mbnfp of- Just nfp -> do- Just (ParsedModule{},_) <- runIdeAction "example" (shakeExtras state) $ useWithStaleFast GetParsedModule nfp- let- title = "Add TODO Item 1"- tedit = [TextEdit (Range (Position 2 0) (Position 2 0))- "-- TODO1 added by Example Plugin directly\n"]- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing- pure $ Right $ List- [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing]- Nothing -> error $ "Unable to get a normalized file path from the uri: " ++ show uri---- -----------------------------------------------------------------------codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens-codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do- logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ- case uriToFilePath' uri of- Just (toNormalizedFilePath -> filePath) -> do- _ <- runIdeAction "Example.codeLens" (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath- _diag <- atomically $ getDiagnostics ideState- _hDiag <- atomically $ getHiddenDiagnostics ideState- let- title = "Add TODO Item via Code Lens"- -- tedit = [TextEdit (Range (Position 3 0) (Position 3 0))- -- "-- TODO added by Example Plugin via code lens action\n"]- -- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing- range = Range (Position 3 0) (Position 4 0)- let cmdParams = AddTodoParams uri "do abc"- cmd = mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams])- pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]- Nothing -> pure $ Right $ List []---- ------------------------------------------------------------------------ | Parameters for the addTodo PluginCommand.-data AddTodoParams = AddTodoParams- { file :: Uri -- ^ Uri of the file to add the pragma to- , todoText :: T.Text- }- deriving (Show, Eq, Generic, ToJSON, FromJSON)--addTodoCmd :: CommandFunction IdeState AddTodoParams-addTodoCmd _ide (AddTodoParams uri todoText) = do- let- pos = Position 3 0- textEdits = List- [TextEdit (Range pos pos)- ("-- TODO:" <> todoText <> "\n")- ]- res = WorkspaceEdit- (Just $ Map.singleton uri textEdits)- Nothing- Nothing- _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())- return $ Right Null---- -----------------------------------------------------------------------foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)-foundHover (mbRange, contents) =- Right $ Just $ Hover (HoverContents $ MarkupContent MkMarkdown- $ T.intercalate sectionSeparator contents) mbRange----- | Respond to and log a hover or go-to-definition request-request- :: T.Text- -> (NormalizedFilePath -> Position -> Action (Maybe a))- -> Either ResponseError b- -> (a -> Either ResponseError b)- -> IdeState- -> TextDocumentPositionParams- -> IO (Either ResponseError b)-request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do- mbResult <- case uriToFilePath' uri of- Just path -> logAndRunRequest label getResults ide pos path- Nothing -> pure Nothing- pure $ maybe notFound found mbResult--logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b)- -> IdeState -> Position -> String -> IO b-logAndRunRequest label getResults ide pos path = do- let filePath = toNormalizedFilePath path- logInfo (ideLogger ide) $- label <> " request at position " <> T.pack (showPosition pos) <>- " in file: " <> T.pack path- runAction "Example" ide $ getResults filePath pos---- -----------------------------------------------------------------------symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol-symbols _ide _pid (DocumentSymbolParams _ _ _doc)- = pure $ Right $ InL $ List [r]- where- r = DocumentSymbol name detail kind Nothing deprecation range selR chList- name = "Example_symbol_name"- detail = Nothing- kind = SkVariable- deprecation = Nothing- range = Range (Position 2 0) (Position 2 5)- selR = range- chList = Nothing---- -----------------------------------------------------------------------completion :: PluginMethodHandler IdeState TextDocumentCompletion-completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)- = pure $ Right $ InL $ List [r]- where- r = CompletionItem label kind tags detail documentation deprecated preselect- sortText filterText insertText insertTextFormat insertTextMode- textEdit additionalTextEdits commitCharacters- command xd- label = "Example completion"- kind = Nothing- tags = Nothing- detail = Nothing- documentation = Nothing- deprecated = Nothing- preselect = Nothing- sortText = Nothing- filterText = Nothing- insertText = Nothing- insertTextMode = Nothing- insertTextFormat = Nothing- textEdit = Nothing- additionalTextEdits = Nothing- commitCharacters = Nothing- command = Nothing- xd = Nothing---- ---------------------------------------------------------------------
− plugins/default/src/Ide/Plugin/Example2.hs
@@ -1,237 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}--module Ide.Plugin.Example2- (- descriptor- , Log(..)- ) where--import Control.Concurrent.STM-import Control.DeepSeq (NFData)-import Control.Monad.IO.Class-import Control.Monad.Trans.Maybe-import Data.Aeson-import Data.Functor-import qualified Data.HashMap.Strict as Map-import Data.Hashable-import qualified Data.Text as T-import Data.Typeable-import Development.IDE as D-import Development.IDE.Core.Shake hiding (Log)-import qualified Development.IDE.Core.Shake as Shake-import GHC.Generics-import Ide.PluginUtils-import Ide.Types-import Language.LSP.Server-import Language.LSP.Types-import Text.Regex.TDFA.Text ()---- -----------------------------------------------------------------------newtype Log = LogShake Shake.Log deriving Show--instance Pretty Log where- pretty = \case- LogShake log -> pretty log--descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState-descriptor recorder plId = (defaultPluginDescriptor plId)- { pluginRules = exampleRules recorder- , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]- , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction- <> mkPluginHandler STextDocumentCodeLens codeLens- <> mkPluginHandler STextDocumentHover hover- <> mkPluginHandler STextDocumentDocumentSymbol symbols- <> mkPluginHandler STextDocumentCompletion completion- }---- -----------------------------------------------------------------------hover :: PluginMethodHandler IdeState TextDocumentHover-hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}--blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))-blah _ (Position line col)- = return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover 2\n"])---- ------------------------------------------------------------------------ Generating Diagnostics via rules--- -----------------------------------------------------------------------data Example2 = Example2- deriving (Eq, Show, Typeable, Generic)-instance Hashable Example2-instance NFData Example2--type instance RuleResult Example2 = ()--exampleRules :: Recorder (WithPriority Log) -> Rules ()-exampleRules recorder = do- define (cmapWithPrio LogShake recorder) $ \Example2 file -> do- _pm <- getParsedModule file- let diag = mkDiag file "example2" DsError (Range (Position 0 0) (Position 1 0)) "example2 diagnostic, hello world"- return ([diag], Just ())-- action $ do- files <- getFilesOfInterestUntracked- void $ uses Example2 $ Map.keys files--mkDiag :: NormalizedFilePath- -> DiagnosticSource- -> DiagnosticSeverity- -> Range- -> T.Text- -> FileDiagnostic-mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)- Diagnostic- { _range = loc- , _severity = Just sev- , _source = Just diagSource- , _message = msg- , _code = Nothing- , _tags = Nothing- , _relatedInformation = Nothing- }---- ------------------------------------------------------------------------ code actions--- ------------------------------------------------------------------------- | Generate code actions.-codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction-codeAction _state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = do- let- title = "Add TODO2 Item"- tedit = [TextEdit (Range (Position 3 0) (Position 3 0))- "-- TODO2 added by Example2 Plugin directly\n"]- edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing- pure $ Right $ List- [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing]---- -----------------------------------------------------------------------codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens-codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do- logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ- case uriToFilePath' uri of- Just (toNormalizedFilePath -> filePath) -> do- _ <- runIdeAction (fromNormalizedFilePath filePath) (shakeExtras ideState) $ runMaybeT $ useE TypeCheck filePath- _diag <- atomically $ getDiagnostics ideState- _hDiag <- atomically $ getHiddenDiagnostics ideState- let- title = "Add TODO2 Item via Code Lens"- range = Range (Position 3 0) (Position 4 0)- let cmdParams = AddTodoParams uri "do abc"- cmd = mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams])- pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]- Nothing -> pure $ Right $ List []---- ------------------------------------------------------------------------ | Parameters for the addTodo PluginCommand.-data AddTodoParams = AddTodoParams- { file :: Uri -- ^ Uri of the file to add the pragma to- , todoText :: T.Text- }- deriving (Show, Eq, Generic, ToJSON, FromJSON)--addTodoCmd :: CommandFunction IdeState AddTodoParams-addTodoCmd _ide (AddTodoParams uri todoText) = do- let- pos = Position 5 0- textEdits = List- [TextEdit (Range pos pos)- ("-- TODO2:" <> todoText <> "\n")- ]- res = WorkspaceEdit- (Just $ Map.singleton uri textEdits)- Nothing- Nothing- _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())- return $ Right Null---- -----------------------------------------------------------------------foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)-foundHover (mbRange, contents) =- Right $ Just $ Hover (HoverContents $ MarkupContent MkMarkdown- $ T.intercalate sectionSeparator contents) mbRange----- | Respond to and log a hover or go-to-definition request-request- :: T.Text- -> (NormalizedFilePath -> Position -> Action (Maybe a))- -> Either ResponseError b- -> (a -> Either ResponseError b)- -> IdeState- -> TextDocumentPositionParams- -> IO (Either ResponseError b)-request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do- mbResult <- case uriToFilePath' uri of- Just path -> logAndRunRequest label getResults ide pos path- Nothing -> pure Nothing- pure $ maybe notFound found mbResult--logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b)- -> IdeState -> Position -> String -> IO b-logAndRunRequest label getResults ide pos path = do- let filePath = toNormalizedFilePath path- logInfo (ideLogger ide) $- label <> " request at position " <> T.pack (showPosition pos) <>- " in file: " <> T.pack path- runAction "Example2" ide $ getResults filePath pos---- -----------------------------------------------------------------------symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol-symbols _ide _ (DocumentSymbolParams _ _ _doc)- = pure $ Right $ InL $ List [r]- where- r = DocumentSymbol name detail kind Nothing deprecation range selR chList- name = "Example2_symbol_name"- detail = Nothing- kind = SkVariable- deprecation = Nothing- range = Range (Position 4 1) (Position 4 7)- selR = range- chList = Nothing---- -----------------------------------------------------------------------completion :: PluginMethodHandler IdeState TextDocumentCompletion-completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)- = pure $ Right $ InL $ List [r]- where- r = CompletionItem label kind tags detail documentation deprecated preselect- sortText filterText insertText insertTextFormat insertTextMode- textEdit additionalTextEdits commitCharacters- command xd- label = "Example2 completion"- kind = Nothing- tags = Nothing- detail = Nothing- documentation = Nothing- deprecated = Nothing- preselect = Nothing- sortText = Nothing- filterText = Nothing- insertText = Nothing- insertTextMode = Nothing- insertTextFormat = Nothing- textEdit = Nothing- additionalTextEdits = Nothing- commitCharacters = Nothing- command = Nothing- xd = Nothing---- ---------------------------------------------------------------------
+ src/HlsPlugins.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+module HlsPlugins where++import Development.IDE.Types.Logger (Pretty (pretty), Recorder,+ WithPriority, cmapWithPrio)+import Ide.PluginUtils (pluginDescToIdePlugins)+import Ide.Types (IdePlugins)++-- fixed plugins+import Development.IDE (IdeState)+import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde++-- haskell-language-server optional plugins+#if hls_qualifyImportedNames+import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames+#endif++#if hls_callHierarchy+import qualified Ide.Plugin.CallHierarchy as CallHierarchy+#endif++#if hls_class+import qualified Ide.Plugin.Class as Class+#endif++#if hls_haddockComments+import qualified Ide.Plugin.HaddockComments as HaddockComments+#endif++#if hls_eval+import qualified Ide.Plugin.Eval as Eval+#endif++#if hls_importLens+import qualified Ide.Plugin.ExplicitImports as ExplicitImports+#endif++#if hls_refineImports+import qualified Ide.Plugin.RefineImports as RefineImports+#endif++#if hls_rename+import qualified Ide.Plugin.Rename as Rename+#endif++#if hls_retrie+import qualified Ide.Plugin.Retrie as Retrie+#endif++#if hls_tactic+import qualified Ide.Plugin.Tactic as Tactic+#endif++#if hls_hlint+import qualified Ide.Plugin.Hlint as Hlint+#endif++#if hls_stan+import qualified Ide.Plugin.Stan as Stan+#endif++#if hls_moduleName+import qualified Ide.Plugin.ModuleName as ModuleName+#endif++#if hls_pragmas+import qualified Ide.Plugin.Pragmas as Pragmas+#endif++#if hls_splice+import qualified Ide.Plugin.Splice as Splice+#endif++#if hls_alternateNumberFormat+import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat+#endif++#if hls_codeRange+import qualified Ide.Plugin.CodeRange as CodeRange+#endif++#if hls_changeTypeSignature+import Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature+#endif++#if hls_gadt+import Ide.Plugin.GADT as GADT+#endif++#if explicitFixity+import Ide.Plugin.ExplicitFixity as ExplicitFixity+#endif++-- formatters++#if hls_floskell+import qualified Ide.Plugin.Floskell as Floskell+#endif++#if hls_fourmolu+import qualified Ide.Plugin.Fourmolu as Fourmolu+#endif++#if hls_ormolu+import qualified Ide.Plugin.Ormolu as Ormolu+#endif++#if hls_stylishHaskell+import qualified Ide.Plugin.StylishHaskell as StylishHaskell+#endif++#if hls_brittany+import qualified Ide.Plugin.Brittany as Brittany+#endif++#if hls_refactor+import qualified Development.IDE.Plugin.CodeAction as Refactor+#endif++data Log = forall a. (Pretty a) => Log a++instance Pretty Log where+ pretty (Log a) = pretty a++-- ---------------------------------------------------------------------++-- | The plugins configured for use in this instance of the language+-- server.+-- These can be freely added or removed to tailor the available+-- features of the server.++idePlugins :: Recorder (WithPriority Log) -> IdePlugins IdeState+idePlugins recorder = pluginDescToIdePlugins allPlugins+ where+ pluginRecorder :: forall log. (Pretty log) => Recorder (WithPriority log)+ pluginRecorder = cmapWithPrio Log recorder+ allPlugins =+#if hls_pragmas+ Pragmas.descriptor "pragmas" :+#endif+#if hls_floskell+ Floskell.descriptor "floskell" :+#endif+#if hls_fourmolu+ Fourmolu.descriptor pluginRecorder "fourmolu" :+#endif+#if hls_tactic+ Tactic.descriptor pluginRecorder "tactics" :+#endif+#if hls_ormolu+ Ormolu.descriptor "ormolu" :+#endif+#if hls_stylishHaskell+ StylishHaskell.descriptor "stylish-haskell" :+#endif+#if hls_rename+ Rename.descriptor pluginRecorder "rename" :+#endif+#if hls_retrie+ Retrie.descriptor "retrie" :+#endif+#if hls_brittany+ Brittany.descriptor "brittany" :+#endif+#if hls_callHierarchy+ CallHierarchy.descriptor :+#endif+#if hls_class+ Class.descriptor pluginRecorder "class" :+#endif+#if hls_haddockComments+ HaddockComments.descriptor pluginRecorder "haddockComments" :+#endif+#if hls_eval+ Eval.descriptor pluginRecorder "eval" :+#endif+#if hls_importLens+ ExplicitImports.descriptor pluginRecorder "importLens" :+#endif+#if hls_qualifyImportedNames+ QualifyImportedNames.descriptor "qualifyImportedNames" :+#endif+#if hls_refineImports+ RefineImports.descriptor pluginRecorder "refineImports" :+#endif+#if hls_moduleName+ ModuleName.descriptor pluginRecorder "moduleName" :+#endif+#if hls_hlint+ Hlint.descriptor pluginRecorder "hlint" :+#endif+#if hls_stan+ Stan.descriptor pluginRecorder "stan" :+#endif+#if hls_splice+ Splice.descriptor "splice" :+#endif+#if hls_alternateNumberFormat+ AlternateNumberFormat.descriptor pluginRecorder :+#endif+#if hls_codeRange+ CodeRange.descriptor pluginRecorder "codeRange" :+#endif+#if hls_changeTypeSignature+ ChangeTypeSignature.descriptor :+#endif+#if hls_gadt+ GADT.descriptor "gadt" :+#endif+#if hls_refactor+ Refactor.iePluginDescriptor pluginRecorder "ghcide-code-actions-imports-exports" :+ Refactor.typeSigsPluginDescriptor pluginRecorder "ghcide-code-actions-type-signatures" :+ Refactor.bindingsPluginDescriptor pluginRecorder "ghcide-code-actions-bindings" :+ Refactor.fillHolePluginDescriptor pluginRecorder "ghcide-code-actions-fill-holes" :+ Refactor.extendImportPluginDescriptor pluginRecorder "ghcide-extend-import-action" :+#endif+ GhcIde.descriptors pluginRecorder+#if explicitFixity+ ++ [ExplicitFixity.descriptor pluginRecorder]+#endif+
src/Ide/Main.hs view
@@ -27,12 +27,12 @@ import qualified Development.IDE.Types.Options as Ghcide import GHC.Stack (emptyCallStack) import qualified HIE.Bios.Environment as HieBios-import HIE.Bios.Types+import HIE.Bios.Types hiding (Log) import Ide.Arguments import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) import Ide.Types (IdePlugins, PluginId (PluginId),- ipMap)+ ipMap, pluginId) import Ide.Version import System.Directory import qualified System.Directory.Extra as IO@@ -80,7 +80,7 @@ ListPluginsMode -> do let pluginNames = sort- $ map ((\(PluginId t) -> T.unpack t) . fst)+ $ map ((\(PluginId t) -> T.unpack t) . pluginId) $ ipMap idePlugins mapM_ putStrLn pluginNames @@ -118,20 +118,19 @@ log Info $ LogDirectory dir when (isLSP argsCommand) $ do- log Info $ LogLspStart ghcideArgs (map fst $ ipMap idePlugins)+ log Info $ LogLspStart ghcideArgs (map pluginId $ ipMap idePlugins) -- exists so old-style logging works. intended to be phased out let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack $ LogOther m)+ args = (if argsTesting then IDEMain.testing else IDEMain.defaultArguments)+ (cmapWithPrio LogIDEMain recorder) logger - IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger)+ IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) args { IDEMain.argCommand = argsCommand- , IDEMain.argsHlsPlugins = idePlugins+ , IDEMain.argsHlsPlugins = IDEMain.argsHlsPlugins args <> idePlugins , IDEMain.argsLogger = pure logger <> pure telemetryLogger , IDEMain.argsThreads = if argsThreads == 0 then Nothing else Just $ fromIntegral argsThreads- , IDEMain.argsIdeOptions = \_config sessionLoader ->- let defOptions = Ghcide.defaultIdeOptions sessionLoader- in defOptions- { Ghcide.optShakeProfiling = argsShakeProfiling- , Ghcide.optTesting = Ghcide.IdeTesting argsTesting- }+ , IDEMain.argsIdeOptions = \config sessionLoader ->+ let defOptions = IDEMain.argsIdeOptions args config sessionLoader+ in defOptions { Ghcide.optShakeProfiling = argsShakeProfiling } }
src/Ide/Version.hs view
@@ -46,13 +46,17 @@ showProgramVersionOfInterest :: ProgramsOfInterest -> String showProgramVersionOfInterest ProgramsOfInterest {..} = unlines- [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion- , "stack:\t\t" ++ showVersionWithDefault stackVersion- , "ghc:\t\t" ++ showVersionWithDefault ghcVersion+ [ showProgramVersion "cabal" cabalVersion+ , showProgramVersion "stack" stackVersion+ , showProgramVersion "ghc" ghcVersion ]++showProgramVersion :: String -> Maybe Version -> String+showProgramVersion name version =+ pad 16 (name ++ ":") ++ showVersionWithDefault version where- showVersionWithDefault :: Maybe Version -> String showVersionWithDefault = maybe "Not found" showVersion+ pad n s = s ++ replicate (n - length s) ' ' findProgramVersions :: IO ProgramsOfInterest findProgramVersions = ProgramsOfInterest@@ -69,8 +73,11 @@ Nothing -> pure Nothing Just path -> readProcessWithExitCode path ["--numeric-version"] "" >>= \case- (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout+ (ExitSuccess, sout, _) -> pure $ mkVersion sout _ -> pure Nothing++mkVersion :: String -> Maybe Version+mkVersion = consumeParser myVersionParser where myVersionParser = do skipSpaces@@ -79,4 +86,5 @@ pure version consumeParser :: ReadP a -> String -> Maybe a- consumeParser p input = listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input+ consumeParser p input =+ listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input
test/functional/Completion.hs view
@@ -138,15 +138,25 @@ , testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "FunctionCompletions.hs" "haskell" - let te = TextEdit (Range (Position 0 41) (Position 0 42)) ", l"+ let te = TextEdit (Range (Position 0 39) (Position 0 39)) ", l" _ <- applyEdit doc te - compls <- getCompletions doc (Position 0 41)+ compls <- getCompletions doc (Position 0 42) item <- getCompletionByLabel "liftA" compls liftIO $ do item ^. label @?= "liftA" item ^. kind @?= Just CiFunction item ^. detail @?= Just "Control.Applicative"++ , testCase "completes locally defined associated type family" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do+ doc <- openDoc "AssociatedTypeFamily.hs" "haskell"++ compls <- getCompletions doc (Position 5 20)+ item <- getCompletionByLabel "Fam" compls+ liftIO $ do+ item ^. label @?= "Fam"+ item ^. kind @?= Just CiStruct+ , contextTests , snippetTests ]
test/functional/Diagnostic.hs view
@@ -10,23 +10,8 @@ -- --------------------------------------------------------------------- tests :: TestTree-tests = testGroup "diagnostics providers" [- basicTests- , warningTests- ]+tests = testGroup "diagnostics providers" [ warningTests ] -basicTests :: TestTree-basicTests = testGroup "Diagnostics work" [- testCase "example plugin produces diagnostics" $- runSession hlsCommandExamplePlugin fullCaps "test/testdata/diagnostics" $ do- doc <- openDoc "Foo.hs" "haskell"- diags <- waitForDiagnosticsFromSource doc "example2"- reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]- liftIO $ do- length diags @?= 1- reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)- reduceDiag ^. LSP.severity @?= Just DsError- ] warningTests :: TestTree warningTests = testGroup "Warnings are warnings" [
test/functional/Format.hs view
@@ -8,6 +8,7 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T+import qualified Data.Text as T import Language.LSP.Test import Language.LSP.Types import qualified Language.LSP.Types.Lens as LSP@@ -47,7 +48,13 @@ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)- liftIO $ resp ^. LSP.result @?= Left (ResponseError InvalidRequest "No plugin enabled for STextDocumentFormatting, available: []" Nothing)+ liftIO $ case resp ^. LSP.result of+ result@(Left (ResponseError reason message Nothing)) -> case reason of+ MethodNotFound -> pure () -- No formatter+ InvalidRequest | "No plugin enabled for STextDocumentFormatting" `T.isPrefixOf` message -> pure ()+ _ -> assertFailure $ "strange response from formatting provider:" ++ show result+ result -> assertFailure $ "strange response from formatting provider:" ++ show result+ , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs"
test/functional/FunctionalCodeAction.hs view
@@ -24,6 +24,7 @@ tests :: TestTree tests = testGroup "code actions" [+#if hls_refactor importTests , packageTests , redundantImportTests@@ -31,6 +32,7 @@ , signatureTests , typedHoleTests , unusedTermTests+#endif ] renameTests :: TestTree
test/functional/HieBios.hs view
@@ -24,7 +24,7 @@ @? "found hover text for main" _ -> error $ "Unexpected hover contents: " ++ show hoverContents - , testCase "reports errors in hie.yaml" $ do+ , expectFailBecause "hie-bios 0.11 has poor error messages" $ testCase "reports errors in hie.yaml" $ do writeFile (hieBiosErrorPath </> "hie.yaml") "" runSession hlsCommand fullCaps hieBiosErrorPath $ do _ <- openDoc "Foo.hs" "haskell"
+ test/testdata/completion/AssociatedTypeFamily.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeFamilies #-}+module AssociatedTypeFamily () where++class C a where+ type Fam a++x :: C a => a -> Fam a+x = undefined
+ test/testdata/hieBiosError/hie.yaml view
test/testdata/wErrorTest/src/WError.hs view
@@ -1,2 +1,3 @@ module WError where+{-# ANN module "HLint: ignore" #-} main = undefined