diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,155 @@ # Changelog for haskell-language-server +## 2.14.0.0 + +- Bindists for GHC 9.14.1 +- Bindists for GHC 9.12.4 +- Bindists for GHC 9.12.2 +- Bindists for GHC 9.10.3 +- Bindists for GHC 9.8.4 +- Bindists for GHC 9.6.7 +- Remove `hls-floskell-plugin` +- Merge `hls-module-name-plugin` into `hls-rename-plugin` +- Support for `ExplicitLevelImports` in GHC 9.14 +- Improved startup responsiveness via decoupled session loader +- Improvements to ghcide + - Print hover types on a single line + - Only show linear arrows when `LinearTypes` is enabled + - Smart-case matching for module and filepath completions +- Improvements to `hls-rename-plugin` + - Cross-module rename enabled by default + - `prepareRename` returns exact identifier range +- Improvements to `hls-refactor-plugin` + - Don't offer 'Add Argument' for qualified names + - Fix spacing in constraint reduction + - Fix `makeDeltaAst` regression (#4731) +- Improvements to `hls-explicit-record-fields-plugin` + - Cursor-aware record expansion + - Distinguish wildcard expansion from record syntax conversion + - Ignore compiler-generated match groups +- Improvements to `hls-notes-plugin` + - Hover and autocompletion for note references and declarations + - Fix crash on single-line comments +- Improvements to `hls-cabal-plugin` + - Completions in `custom-setup` stanzas +- Improvements to `hls-fourmolu-plugin` / `hls-ormolu-plugin` + - Show actual parse errors from external formatters + +### Pull Requests + +- Allow skipping over non-required progress messages + ([#4896](https://github.com/haskell/haskell-language-server/pull/4896)) by @crtschin +- Cleanup 9.4 leftovers, fix couple -Wunused-packages and import warnings + ([#4893](https://github.com/haskell/haskell-language-server/pull/4893)) by @jhrcek +- Keep communication pipes between lsp-test and ghcide alive for the entire test + ([#4892](https://github.com/haskell/haskell-language-server/pull/4892)) by @crtschin +- Cancel outstanding threads prior to closing sqlite connection + ([#4886](https://github.com/haskell/haskell-language-server/pull/4886)) by @crtschin +- Bump cachix/cachix-action from 16 to 17 + ([#4872](https://github.com/haskell/haskell-language-server/pull/4872)) by @dependabot[bot] +- Fix cache clearing job + ([#4868](https://github.com/haskell/haskell-language-server/pull/4868)) by @vidit-od +- Improve `prepareRename` responses + ([#4867](https://github.com/haskell/haskell-language-server/pull/4867)) by @izuzu-izuzu +- Migrate stackage build on GHA + ([#4865](https://github.com/haskell/haskell-language-server/pull/4865)) by @vidit-od +- new snapshot for stack build + ([#4864](https://github.com/haskell/haskell-language-server/pull/4864)) by @vidit-od +- Pin version of extra to 1.8.1 for stack + ([#4863](https://github.com/haskell/haskell-language-server/pull/4863)) by @fendor +- Only show linear arrows on data constructors with LinearTypes + ([#4862](https://github.com/haskell/haskell-language-server/pull/4862)) by @crtschin +- Use 2 spaces for tab in HLS + ([#4860](https://github.com/haskell/haskell-language-server/pull/4860)) by @fendor +- Produce structured error for unknown module + ([#4857](https://github.com/haskell/haskell-language-server/pull/4857)) by @vidit-od +- Use Server side Diagnostics + ([#4856](https://github.com/haskell/haskell-language-server/pull/4856)) by @vidit-od +- Fix: Show actual parse errors for external Fourmolu/Ormolu + ([#4855](https://github.com/haskell/haskell-language-server/pull/4855)) by @ijatinydv +- Fixes redundant hash in ghcide cache path (getCacheDirsDefault) + ([#4854](https://github.com/haskell/haskell-language-server/pull/4854)) by @adpad-13 +- fix(refactor): do not offer 'Add Argument' for qualified names + ([#4852](https://github.com/haskell/haskell-language-server/pull/4852)) by @ijatinydv +- Prefer extending import code actions + ([#4851](https://github.com/haskell/haskell-language-server/pull/4851)) by @vherrmann +- Custom-setups completion in cabal files + ([#4848](https://github.com/haskell/haskell-language-server/pull/4848)) by @vidit-od +- Move hls-module-name-plugin into hls-rename-plugin + ([#4847](https://github.com/haskell/haskell-language-server/pull/4847)) by @fendor +- ghcide: implement level-aware module graph edges for GHC 9.14+ + ([#4846](https://github.com/haskell/haskell-language-server/pull/4846)) by @ijatinydv +- fix spacing issues while refactor-reduce + ([#4841](https://github.com/haskell/haskell-language-server/pull/4841)) by @vidit-od +- Remove Floskell support + ([#4838](https://github.com/haskell/haskell-language-server/pull/4838)) by @omarjatoi +- Ignore records in matching groups that are compiler-generated + ([#4837](https://github.com/haskell/haskell-language-server/pull/4837)) by @ozkutuk +- Add tasty-options to control test execution + ([#4835](https://github.com/haskell/haskell-language-server/pull/4835)) by @observant2 +- Use `VirtualFileTree` in `hls-call-hierarchy-plugin-tests` + ([#4834](https://github.com/haskell/haskell-language-server/pull/4834)) by @fendor +- fix notes crashing and leaking single comments notes + ([#4828](https://github.com/haskell/haskell-language-server/pull/4828)) by @vidit-od +- Also add max-backjumps to caching job + ([#4827](https://github.com/haskell/haskell-language-server/pull/4827)) by @jhrcek +- docs: add WSL build location note for contributors + ([#4824](https://github.com/haskell/haskell-language-server/pull/4824)) by @Siya-05 +- Smart Casing in modules and file paths + ([#4823](https://github.com/haskell/haskell-language-server/pull/4823)) by @vidit-od +- Prune allow-newer for ghc 9.14, bump hiedb to 0.8 + ([#4821](https://github.com/haskell/haskell-language-server/pull/4821)) by @jhrcek +- Distinguish between wildcard expansion and traditional record syntax + ([#4819](https://github.com/haskell/haskell-language-server/pull/4819)) by @ozkutuk +- Enable `crossModule` option by default + ([#4817](https://github.com/haskell/haskell-language-server/pull/4817)) by @Aster89 +- Re-introduce call to `makeDeltaAst` to fix #4731 + ([#4814](https://github.com/haskell/haskell-language-server/pull/4814)) by @Aster89 +- Cursor aware record expansion + ([#4813](https://github.com/haskell/haskell-language-server/pull/4813)) by @vidit-od +- Bump GHA versions + ([#4812](https://github.com/haskell/haskell-language-server/pull/4812)) by @fendor +- Use macos-15-intel runners instead of arm macos-15 + ([#4811](https://github.com/haskell/haskell-language-server/pull/4811)) by @fendor +- Bump haskell-actions/setup from 2.8.2 to 2.10.3 + ([#4809](https://github.com/haskell/haskell-language-server/pull/4809)) by @dependabot[bot] +- Bump hlint action, move options to .hlint.yaml + ([#4808](https://github.com/haskell/haskell-language-server/pull/4808)) by @philderbeast +- Add nix devShell for GHC 9.14 + ([#4804](https://github.com/haskell/haskell-language-server/pull/4804)) by @jian-lin +- Print type in one line + ([#4803](https://github.com/haskell/haskell-language-server/pull/4803)) by @jian-lin +- Use Data.HashMap.lookupKey and Data.HashSet.lookupElement + ([#4802](https://github.com/haskell/haskell-language-server/pull/4802)) by @sjakobi +- Mark 9.4.8 as deprecated + ([#4801](https://github.com/haskell/haskell-language-server/pull/4801)) by @fendor +- Fix cache job on windows + ([#4800](https://github.com/haskell/haskell-language-server/pull/4800)) by @fendor +- Fix GHC support table for 9.4.8 + ([#4799](https://github.com/haskell/haskell-language-server/pull/4799)) by @fendor +- More ghcup-metadata tweaks + ([#4798](https://github.com/haskell/haskell-language-server/pull/4798)) by @fendor +- Bump haskell-actions/setup from 2.8.2 to 2.10.3 in /.github/actions/setup-build + ([#4796](https://github.com/haskell/haskell-language-server/pull/4796)) by @dependabot[bot] +- Bump actions/cache from 3 to 5 in /.github/actions/setup-build + ([#4795](https://github.com/haskell/haskell-language-server/pull/4795)) by @dependabot[bot] +- Bump actions/cache from 3 to 5 + ([#4793](https://github.com/haskell/haskell-language-server/pull/4793)) by @dependabot[bot] +- Improving Notes Plugin + ([#4791](https://github.com/haskell/haskell-language-server/pull/4791)) by @vidit-od +- fix: git sub-repository files listing (#4788) + ([#4790](https://github.com/haskell/haskell-language-server/pull/4790)) by @blackheaven +- Prepare release 2.13.0.0 + ([#4785](https://github.com/haskell/haskell-language-server/pull/4785)) by @fendor +- ghcide: Require unordered-containers >= 0.2.21 + ([#4774](https://github.com/haskell/haskell-language-server/pull/4774)) by @sjakobi +- Fix broken pipe during test and gracefully exit the server + ([#4701](https://github.com/haskell/haskell-language-server/pull/4701)) by @soulomoon +- Change tracking of file types to language kinds + ([#4621](https://github.com/haskell/haskell-language-server/pull/4621)) by @VeryMilkyJoe +- Decouple the session loader into reader and writer over the cache + ([#4445](https://github.com/haskell/haskell-language-server/pull/4445)) by @soulomoon + ## 2.13.0.0 - Bindists for GHC 9.14.1 @@ -7,7 +157,6 @@ - Bindists for GHC 9.10.3 - Bindists for GHC 9.8.4 - Bindists for GHC 9.6.7 -- Last release supporting GHC 9.6 Support for GHC 9.14.1 is preliminary, some plugins are not yet support but will be in the future. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,6 @@ [![Release][badge-github-release]][github-release] [![Hackage][badge-hackage]][hackage] [![License Apache 2.0][badge-license]][license] -[![CircleCI][badge-circleci]][circleci] [![GitHub Testing Workflow](https://github.com/haskell/haskell-language-server/actions/workflows/test.yml/badge.svg)](https://github.com/haskell/haskell-language-server/actions/workflows/test.yml) [![GitHub Nix Workflow](https://github.com/haskell/haskell-language-server/actions/workflows/nix.yml/badge.svg)](https://github.com/haskell/haskell-language-server/actions/workflows/nix.yml) [![matrix][badge-matrix]][matrix] @@ -15,8 +14,6 @@ [logo]: ./docs/logos/logo-256.png [badge-license]: https://img.shields.io/badge/license-Apache2-green.svg?dummy [license]: https://github.com/haskell/haskell-language-server/blob/master/LICENSE -[badge-circleci]: https://img.shields.io/circleci/project/github/haskell/haskell-language-server/master.svg -[circleci]: https://circleci.com/gh/haskell/haskell-language-server/ [badge-hackage]: https://img.shields.io/hackage/v/haskell-language-server.svg?logo=haskell [badge-github-release]:https://img.shields.io/github/v/release/haskell/haskell-language-server.svg [hackage]: https://hackage.haskell.org/package/haskell-language-server diff --git a/docs/contributing/plugin-tutorial.lhs b/docs/contributing/plugin-tutorial.lhs --- a/docs/contributing/plugin-tutorial.lhs +++ b/docs/contributing/plugin-tutorial.lhs @@ -75,7 +75,7 @@ The HLS codebase includes several plugins (found in `./plugins`). For example: -- The `ormolu`, `fourmolu`, `floskell` and `stylish-haskell` plugins used to format code +- The `ormolu`, `fourmolu`, and `stylish-haskell` plugins used to format code - The `eval` plugin, a code lens provider to evaluate code in comments - The `retrie` plugin, a code action provider to execute retrie commands @@ -95,7 +95,6 @@ allPlugins = [ GhcIde.descriptor "ghcide" , Pragmas.descriptor "pragmas" - , Floskell.descriptor "floskell" , Fourmolu.descriptor "fourmolu" , Ormolu.descriptor "ormolu" , StylishHaskell.descriptor "stylish-haskell" diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -132,7 +132,13 @@ hPutStrLn stderr $ "Current directory: " ++ d hPutStrLn stderr $ "Operating system: " ++ os args <- getArgs - hPutStrLn stderr $ "Arguments: " ++ show args + let args' = case parsedArgs of + Ghcide GhcideArguments{..} + -- If no --cwd is given, assume the current working directory as the --cwd + | isNothing argsCwd -> args ++ ["--cwd", argsInitialWorkingDirectory] + _ -> args + + hPutStrLn stderr $ "Arguments: " ++ show args' hPutStrLn stderr $ "Cradle directory: " ++ cradleRootDir cradle hPutStrLn stderr $ "Cradle type: " ++ show (actionName (cradleOptsProg cradle)) programsOfInterest <- findProgramVersions @@ -162,7 +168,7 @@ liftIO $ hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e #ifdef mingw32_HOST_OS - liftIO $ callProcess e args + liftIO $ callProcess e args' #else let Cradle { cradleOptsProg = CradleAction { runGhcCmd } } = cradle @@ -177,7 +183,7 @@ 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)) + liftIO $ executeFile e True args' (Just (Map.toList newEnv)) #endif diff --git a/ghcide-test/data/hover/Constructors.hs b/ghcide-test/data/hover/Constructors.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/hover/Constructors.hs @@ -0,0 +1,8 @@ +module Constructors where + +data A = A +data B = B Int Word Bool +data C = C ![Int] {-# UNPACK #-} !Bool +data D = D { da :: Int, db :: Bool } +data E = E { ea :: !Int, eb :: {-# UNPACK #-} ![Bool] } +newtype F = F Int diff --git a/ghcide-test/data/hover/ConstructorsLinear.hs b/ghcide-test/data/hover/ConstructorsLinear.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/hover/ConstructorsLinear.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE LinearTypes #-} +module ConstructorsLinear where + +data A = A +data B = B Int Word Bool +data C = C ![Int] {-# UNPACK #-} !Bool +data D = D { da :: Int, db :: Bool } +data E = E { ea :: !Int, eb :: {-# UNPACK #-} ![Bool] } +newtype F = F Int diff --git a/ghcide-test/data/hover/hie.yaml b/ghcide-test/data/hover/hie.yaml --- a/ghcide-test/data/hover/hie.yaml +++ b/ghcide-test/data/hover/hie.yaml @@ -1,1 +1,1 @@ -cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover", "RecordDotSyntax", "GotoImplementation"]}} +cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover", "RecordDotSyntax", "GotoImplementation", "Constructors", "ConstructorsLinear"]}} diff --git a/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/PackageInfo_a.hs b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/PackageInfo_a.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/PackageInfo_a.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -Wno-missing-import-lists #-} +{-# OPTIONS_GHC -w #-} + +{-| +Module : PackageInfo_a +Description : Contents of some of the package's Cabal file's fields. + +WARNING: This module was generated by Cabal. Any modifications will be +overwritten if the module is regenerated. + +This module exports values that record information from some of the fields of +the package's Cabal package description file (Cabal file). + +For further information about the fields in a Cabal file, see the Cabal User +Guide. +-} + +module PackageInfo_a ( + name, + version, + synopsis, + copyright, + homepage, + ) where + +import Data.Version (Version(..)) +import Prelude + +-- |The content of the @name@ field of the package's Cabal file, but with any +-- hyphen characters replaced by underscore characters. +name :: String +name = "a" +-- |The content of the @version@ field of the package's Cabal file. +version :: Version +version = Version [1,0,0] [] + +-- |The content of the @synopsis@ field of the package's Cabal file. +synopsis :: String +synopsis = "" +-- |The content of the @copyright@ field of the package's Cabal file. +copyright :: String +copyright = "" +-- |The content of the @homepage@ field of the package's Cabal file. +homepage :: String +homepage = "" diff --git a/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/Paths_a.hs b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/Paths_a.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.10.3/a-1.0.0/build/autogen/Paths_a.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +#if __GLASGOW_HASKELL__ >= 810 +{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} +#endif +{-# OPTIONS_GHC -Wno-missing-import-lists #-} +{-# OPTIONS_GHC -w #-} + +{-| +Module : Paths_a +Description : Data file location, and package version and installation + directories. + +WARNING: This module was generated by Cabal. Any modifications will be +overwritten if the module is regenerated. + +This module exports a function to locate data files, and values that record +the version of the package and some directories which the package has been +configured to be installed into. + +For further information about Cabal's options for its configuration step, and +their default values, see the Cabal User Guide. +-} + +module Paths_a ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +-- |The package version. +version :: Version +version = Version [1,0,0] [] + +-- |If the argument is a filename, the result is the name of a corresponding +-- file on the system on which the program is running, if the file were listed +-- in the @data-files@ field of the package's Cabal package description file. +-- No check is performed that the given filename is listed in that field. +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir `joinFileName` name) + +-- |The location of the directory specified by Cabal's @--bindir@ option (where +-- executables that the user might invoke are installed). This can be overridden +-- at runtime using the environment variable a_bindir. +getBinDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--libdir@ option (where +-- object libraries are installed). This can be overridden at runtime using the +-- environment variable a_libdir. +getLibDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--dynlibdir@ option +-- (where dynamic libraries are installed). This can be overridden at runtime +-- using the environment variable a_dynlibdir. +getDynLibDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--datadir@ option (where +-- architecture-independent data files are installed). This can be overridden at +-- runtime using the environment variable a_datadir. +getDataDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--libexedir@ option +-- (where executables that are not expected to be invoked directly by the user +-- are installed). This can be overridden at runtime using the environment +-- variable a_libexedir. +getLibexecDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--sysconfdir@ option +-- (where configuration files are installed). This can be overridden at runtime +-- using the environment variable a_sysconfdir. +getSysconfDir :: IO FilePath + + + + +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath +bindir = "/home/zubin/.cabal/bin" +libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c/a-1.0.0-inplace" +dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c" +datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.10.3-415c/a-1.0.0" +libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.10.3-415c/a-1.0.0" +sysconfdir = "/home/zubin/.cabal/etc" + +getBinDir = catchIO (getEnv "a_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "a_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "a_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "a_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir) + + + +joinFileName :: String -> String -> FilePath +joinFileName "" fname = fname +joinFileName "." fname = fname +joinFileName dir "" = dir +joinFileName dir@(c:cs) fname + | isPathSeparator (lastChar c cs) = dir ++ fname + | otherwise = dir ++ pathSeparator : fname + where + -- We do not use Data.List.NonEmpty.last, as that would limit the module to + -- base >= 4.9.0.0 (GHC >= 8.0.1). + lastChar x [] = x + lastChar _ (x:xs) = lastChar x xs + +pathSeparator :: Char +pathSeparator = '/' + +isPathSeparator :: Char -> Bool +isPathSeparator c = c == '/' diff --git a/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/PackageInfo_a.hs b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/PackageInfo_a.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/PackageInfo_a.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoRebindableSyntax #-} +{-# OPTIONS_GHC -Wno-missing-import-lists #-} +{-# OPTIONS_GHC -w #-} + +{-| +Module : PackageInfo_a +Description : Contents of some of the package's Cabal file's fields. + +WARNING: This module was generated by Cabal. Any modifications will be +overwritten if the module is regenerated. + +This module exports values that record information from some of the fields of +the package's Cabal package description file (Cabal file). + +For further information about the fields in a Cabal file, see the Cabal User +Guide. +-} + +module PackageInfo_a ( + name, + version, + synopsis, + copyright, + homepage, + ) where + +import Data.Version (Version(..)) +import Prelude + +-- |The content of the @name@ field of the package's Cabal file, but with any +-- hyphen characters replaced by underscore characters. +name :: String +name = "a" +-- |The content of the @version@ field of the package's Cabal file. +version :: Version +version = Version [1,0,0] [] + +-- |The content of the @synopsis@ field of the package's Cabal file. +synopsis :: String +synopsis = "" +-- |The content of the @copyright@ field of the package's Cabal file. +copyright :: String +copyright = "" +-- |The content of the @homepage@ field of the package's Cabal file. +homepage :: String +homepage = "" diff --git a/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/Paths_a.hs b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/Paths_a.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.14.1/a-1.0.0/build/autogen/Paths_a.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoRebindableSyntax #-} +#if __GLASGOW_HASKELL__ >= 810 +{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} +#endif +{-# OPTIONS_GHC -Wno-missing-import-lists #-} +{-# OPTIONS_GHC -w #-} + +{-| +Module : Paths_a +Description : Data file location, and package version and installation + directories. + +WARNING: This module was generated by Cabal. Any modifications will be +overwritten if the module is regenerated. + +This module exports a function to locate data files, and values that record +the version of the package and some directories which the package has been +configured to be installed into. + +For further information about Cabal's options for its configuration step, and +their default values, see the Cabal User Guide. +-} + +module Paths_a ( + version, + getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, + getDataFileName, getSysconfDir + ) where + + +import qualified Control.Exception as Exception +import Data.Version (Version(..)) +import System.Environment (getEnv) +import Prelude + + +#if defined(VERSION_base) + +#if MIN_VERSION_base(4,0,0) +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#else +catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a +#endif + +#else +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#endif +catchIO = Exception.catch + +-- |The package version. +version :: Version +version = Version [1,0,0] [] + +-- |If the argument is a filename, the result is the name of a corresponding +-- file on the system on which the program is running, if the file were listed +-- in the @data-files@ field of the package's Cabal package description file. +-- No check is performed that the given filename is listed in that field. +getDataFileName :: FilePath -> IO FilePath +getDataFileName name = do + dir <- getDataDir + return (dir `joinFileName` name) + +-- |The location of the directory specified by Cabal's @--bindir@ option (where +-- executables that the user might invoke are installed). This can be overridden +-- at runtime using the environment variable a_bindir. +getBinDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--libdir@ option (where +-- object libraries are installed). This can be overridden at runtime using the +-- environment variable a_libdir. +getLibDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--dynlibdir@ option +-- (where dynamic libraries are installed). This can be overridden at runtime +-- using the environment variable a_dynlibdir. +getDynLibDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--datadir@ option (where +-- architecture-independent data files are installed). This can be overridden at +-- runtime using the environment variable a_datadir. +getDataDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--libexedir@ option +-- (where executables that are not expected to be invoked directly by the user +-- are installed). This can be overridden at runtime using the environment +-- variable a_libexedir. +getLibexecDir :: IO FilePath + +-- |The location of the directory specified by Cabal's @--sysconfdir@ option +-- (where configuration files are installed). This can be overridden at runtime +-- using the environment variable a_sysconfdir. +getSysconfDir :: IO FilePath + + + + +bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath +bindir = "/home/zubin/.cabal/bin" +libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7/a-1.0.0-inplace" +dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7" +datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.14.1-ade7/a-1.0.0" +libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.14.1-ade7/a-1.0.0" +sysconfdir = "/home/zubin/.cabal/etc" + +getBinDir = catchIO (getEnv "a_bindir") (\_ -> return bindir) +getLibDir = catchIO (getEnv "a_libdir") (\_ -> return libdir) +getDynLibDir = catchIO (getEnv "a_dynlibdir") (\_ -> return dynlibdir) +getDataDir = catchIO (getEnv "a_datadir") (\_ -> return datadir) +getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir) +getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir) + + + +joinFileName :: String -> String -> FilePath +joinFileName "" fname = fname +joinFileName "." fname = fname +joinFileName dir "" = dir +joinFileName dir@(c:cs) fname + | isPathSeparator (lastChar c cs) = dir ++ fname + | otherwise = dir ++ pathSeparator : fname + where + -- We do not use Data.List.NonEmpty.last, as that would limit the module to + -- base >= 4.9.0.0 (GHC >= 8.0.1). + lastChar x [] = x + lastChar _ (x:xs) = lastChar x xs + +pathSeparator :: Char +pathSeparator = '/' + +isPathSeparator :: Char -> Bool +isPathSeparator c = c == '/' diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module PackageInfo_plugin ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - -name :: String -name = "plugin" -version :: Version -version = Version [1,0,0] [] - -synopsis :: String -synopsis = "" -copyright :: String -copyright = "" -homepage :: String -homepage = "" diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/Paths_plugin.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/Paths_plugin.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/plugin-1.0.0/build/autogen/Paths_plugin.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module Paths_plugin ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import qualified Data.List as List -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [1,0,0] [] - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.2-d434/plugin-1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.2-d434" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.2-d434/plugin-1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.2-d434/plugin-1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "plugin_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "plugin_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "plugin_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "plugin_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "plugin_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "plugin_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir fname - | isPathSeparator (List.last dir) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/PackageInfo_usage.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/PackageInfo_usage.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/PackageInfo_usage.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module PackageInfo_usage ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - -name :: String -name = "usage" -version :: Version -version = Version [1,0,0] [] - -synopsis :: String -synopsis = "" -copyright :: String -copyright = "" -homepage :: String -homepage = "" diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/Paths_usage.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/Paths_usage.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.2/usage-1.0.0/build/autogen/Paths_usage.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module Paths_usage ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import qualified Data.List as List -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [1,0,0] [] - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.2-d434/usage-1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.2-d434" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.2-d434/usage-1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.2-d434/usage-1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "usage_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "usage_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "usage_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "usage_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "usage_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "usage_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir fname - | isPathSeparator (List.last dir) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/PackageInfo_plugin.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module PackageInfo_plugin ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - -name :: String -name = "plugin" -version :: Version -version = Version [1,0,0] [] - -synopsis :: String -synopsis = "" -copyright :: String -copyright = "" -homepage :: String -homepage = "" diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/Paths_plugin.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/Paths_plugin.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/plugin-1.0.0/build/autogen/Paths_plugin.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module Paths_plugin ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import qualified Data.List as List -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [1,0,0] [] - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c/plugin-1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.3-415c/plugin-1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.3-415c/plugin-1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "plugin_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "plugin_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "plugin_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "plugin_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "plugin_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "plugin_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir fname - | isPathSeparator (List.last dir) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/PackageInfo_usage.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/PackageInfo_usage.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/PackageInfo_usage.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module PackageInfo_usage ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - -name :: String -name = "usage" -version :: Version -version = Version [1,0,0] [] - -synopsis :: String -synopsis = "" -copyright :: String -copyright = "" -homepage :: String -homepage = "" diff --git a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/Paths_usage.hs b/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/Paths_usage.hs deleted file mode 100644 --- a/ghcide-test/data/plugin-parser/dist-newstyle/build/x86_64-linux/ghc-9.10.3/usage-1.0.0/build/autogen/Paths_usage.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} -module Paths_usage ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import qualified Data.List as List -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - -version :: Version -version = Version [1,0,0] [] - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - -getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c/usage-1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.3-415c/usage-1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.3-415c/usage-1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "usage_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "usage_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "usage_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "usage_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "usage_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "usage_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir fname - | isPathSeparator (List.last dir) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/ghcide-test/exe/BootTests.hs b/ghcide-test/exe/BootTests.hs --- a/ghcide-test/exe/BootTests.hs +++ b/ghcide-test/exe/BootTests.hs @@ -1,6 +1,6 @@ module BootTests (tests) where -import Config (checkDefs, mkR, runInDir, +import Config (checkDefs, mkR, runWithExtraFiles) import Control.Applicative.Combinators import Control.Monad diff --git a/ghcide-test/exe/ConstructorHoverTests.hs b/ghcide-test/exe/ConstructorHoverTests.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/exe/ConstructorHoverTests.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ConstructorHoverTests (tests) where + +import Config +import Hover +import Test.Hls +import Test.Hls.FileSystem (copyDir) + +tests :: TestTree +tests = + testGroup + "constructor hover (#2904)" + [ testGroup + "Constructors.hs" + [ test "A" "Constructors.hs" (Position 2 9) [ExpectHoverText ["A :: A"]] + , test "B" "Constructors.hs" (Position 3 9) [ExpectHoverText ["B :: Int -> Word -> Bool -> B"], ExpectHoverExcludeText ["%1 ->"]] + , test "C" "Constructors.hs" (Position 4 9) [ExpectHoverText ["C :: [Int] -> Bool -> C"], ExpectHoverExcludeText ["%1 ->"]] + , test "D" "Constructors.hs" (Position 5 9) [ExpectHoverText ["D :: Int -> Bool -> D"], ExpectHoverExcludeText ["%1 ->"]] + , test "E" "Constructors.hs" (Position 6 9) [ExpectHoverText ["E :: Int -> [Bool] -> E"], ExpectHoverExcludeText ["%1 ->"]] + , test "F" "Constructors.hs" (Position 7 12) [ExpectHoverText ["F :: Int -> F"], ExpectHoverExcludeText ["%1 ->"]] + ] + , testGroup + "ConstructorsLinear.hs" + [ test "A" "ConstructorsLinear.hs" (Position 3 9) [ExpectHoverText ["A :: A"]] + , test "B" "ConstructorsLinear.hs" (Position 4 9) [ExpectHoverText ["B :: Int %1 -> Word %1 -> Bool %1 -> B"]] + , test "C" "ConstructorsLinear.hs" (Position 5 9) [ExpectHoverText ["C :: [Int] %1 -> Bool %1 -> C"]] + , test "D" "ConstructorsLinear.hs" (Position 6 9) [ExpectHoverText ["D :: Int %1 -> Bool %1 -> D"]] + , test "E" "ConstructorsLinear.hs" (Position 7 9) [ExpectHoverText ["E :: Int %1 -> [Bool] %1 -> E"]] + , test "F" "ConstructorsLinear.hs" (Position 8 12) [ExpectHoverText ["F :: Int %1 -> F"]] + ] + ] + +test :: String -> FilePath -> Position -> [Expect] -> TestTree +test title fileName pos expectations = + testWithDummyPlugin title (mkIdeTestFs [copyDir "hover"]) $ do + doc <- openDoc fileName "haskell" + waitForProgressDone + hover <- getHover doc pos + checkHover hover expectations diff --git a/ghcide-test/exe/CradleTests.hs b/ghcide-test/exe/CradleTests.hs --- a/ghcide-test/exe/CradleTests.hs +++ b/ghcide-test/exe/CradleTests.hs @@ -1,17 +1,22 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} module CradleTests (tests) where -import Config (checkDefs, mkL, +import Config (checkDefs, dummyPlugin, + lspTestCaps, mkIdeTestFs, mkL, runWithExtraFiles, testWithDummyPluginEmpty') import Control.Applicative.Combinators import Control.Lens ((^.)) import Control.Monad.IO.Class (liftIO) +import qualified Data.Aeson as A +import Data.Proxy (Proxy (..)) import qualified Data.Text as T import Development.IDE.GHC.Util -import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..)) +import Development.IDE.Plugin.Test (TestRequest (..), + WaitForIdeRuleResult (..)) import Development.IDE.Test (expectDiagnostics, expectDiagnosticsWithTags, expectNoMoreDiagnostics, @@ -19,6 +24,8 @@ waitForAction) import Development.IDE.Types.Location import GHC.TypeLits (symbolVal) +import Ide.Types (Config (..), + SessionLoadingPreferenceConfig (..)) import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types hiding @@ -28,7 +35,9 @@ mkRange) import Language.LSP.Test import System.FilePath -import System.IO.Extra hiding (withTempDir) +import Test.Hls (TestConfig (..), def, + runSessionWithTestConfig, + waitForBuildQueue) import Test.Hls.FileSystem import Test.Hls.Util (EnvSpec (..), OS (..), ignoreInEnv) @@ -41,6 +50,7 @@ [testGroup "dependencies" [sessionDepsArePickedUp] ,testGroup "ignore-fatal" [ignoreFatalWarning] ,testGroup "loading" [loadCradleOnlyonce, retryFailedCradle] + ,testGroup "regression.batch" batchLoadRegressionTests ,testGroup "multi" (multiTests "multi") ,testGroup "multi-unit" (multiTests "multi-unit") ,testGroup "sub-directory" [simpleSubDirectoryTest] @@ -173,6 +183,218 @@ let fooL = mkL auri 2 0 2 3 checkDefs locs (pure [fooL]) expectNoMoreDiagnostics 0.5 + +runRegressionMultiOpenAThenB :: FilePath -> Session () +runRegressionMultiOpenAThenB dir = do + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + adoc <- openDoc aPath "haskell" + bdoc <- openDoc bPath "haskell" + _ <- waitForBuildQueue + [aRes, bRes] <- waitForTypeChecksBatched [adoc, bdoc] + liftIO $ assertBool "A should typecheck" (ideResultSuccess aRes) + liftIO $ assertBool "B should typecheck" (ideResultSuccess bRes) + locs <- getDefinitions bdoc (Position 2 7) + let fooL = mkL (adoc ^. L.uri) 2 0 2 3 + checkDefs locs (pure [fooL]) + expectNoMoreDiagnostics 0.5 + +runRegressionMultiOpenBThenA :: FilePath -> Session () +runRegressionMultiOpenBThenA dir = do + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + bdoc <- openDoc bPath "haskell" + adoc <- openDoc aPath "haskell" + _ <- waitForBuildQueue + [bRes, aRes] <- waitForTypeChecksBatched [bdoc, adoc] + liftIO $ assertBool "B should typecheck" (ideResultSuccess bRes) + liftIO $ assertBool "A should typecheck" (ideResultSuccess aRes) + locs <- getDefinitions bdoc (Position 2 7) + let TextDocumentIdentifier auri = adoc + let fooL = mkL auri 2 0 2 3 + checkDefs locs (pure [fooL]) + expectNoMoreDiagnostics 0.5 + +runRegressionMultiOpenBThenAThenC :: FilePath -> Session () +runRegressionMultiOpenBThenAThenC dir = do + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + cPath = dir "c/C.hs" + bdoc <- openDoc bPath "haskell" + adoc <- openDoc aPath "haskell" + cdoc <- openDoc cPath "haskell" + _ <- waitForBuildQueue + [bRes, aRes, cRes] <- waitForTypeChecksBatched [bdoc, adoc, cdoc] + liftIO $ assertBool "B should typecheck" (ideResultSuccess bRes) + liftIO $ assertBool "A should typecheck" (ideResultSuccess aRes) + liftIO $ assertBool "C should typecheck" (ideResultSuccess cRes) + locs <- getDefinitions cdoc (Position 2 7) + let TextDocumentIdentifier auri = adoc + let fooL = mkL auri 2 0 2 3 + checkDefs locs (pure [fooL]) + expectNoMoreDiagnostics 0.5 + +sendTestRequest :: TestRequest -> Session A.Value +sendTestRequest req = do + let method = SMethod_CustomMethod (Proxy @"test") + reqId <- sendRequest method (A.toJSON req) + TResponseMessage{_result} <- skipManyTill anyMessage $ responseForId method reqId + case _result of + Left err -> liftIO (assertFailure $ "test plugin request failed: " <> show err) >> pure A.Null + Right val -> pure val + +waitForTypeChecksBatched :: [TextDocumentIdentifier] -> Session [WaitForIdeRuleResult] +waitForTypeChecksBatched docs = do + let uris = map (\TextDocumentIdentifier{_uri} -> _uri) docs + val <- sendTestRequest (WaitForIdeRules "TypeCheck" uris) + case A.fromJSON val of + A.Success res -> pure res + A.Error parseErr -> liftIO (assertFailure $ "batched typecheck parse failed: " <> parseErr) >> pure [] + +batchLoadRegressionTests :: [TestTree] +batchLoadRegressionTests = + -- Note [Batch regression scheduling semantics] + -- `didOpen` alone does not enqueue session-loader pending files. + -- Pending entries come from GhcSession demand. For these tests, the `test` + -- plugin uses `WaitForIdeRules` plus a pending-size barrier in session-loader + -- to force all requested files into pending before load begins. + [ testCase "m1-open-a-then-b-batch-pending-and-success" $ + runWithExtraFilesMultiComponent "multi" runRegressionMultiOpenAThenB + , testCase "m2-open-b-then-a-batch-pending-and-success" $ + runWithExtraFilesMultiComponent "multi" runRegressionMultiOpenBThenA + , testCase "m3-open-b-then-a-then-c-batch-pending-and-success" $ + runWithExtraFilesMultiComponent "multi" runRegressionMultiOpenBThenAThenC + , testCase "f1-batch-pending-failure-isolates-broken-file" $ + runWithExtraFilesMultiComponent "multi" regressionBatchFailureIsolatesBrokenFile + , testCase "f2-failed-file-keeps-failing-until-cradle-fix" $ + runWithExtraFilesMultiComponent "multi" regressionFailedFileKeepsFailingUntilFix + , testCase "r1-failed-file-recovers-after-cradle-fix" $ + runWithExtraFilesMultiComponent "multi" regressionFailedFileRecoversAfterFix + , testCase "s1-no-stale-outcomes-across-restart-paths" $ + runWithExtraFilesMultiComponent "multi" regressionNoStaleOutcomesOnRestart + ] + +runWithExtraFilesMultiComponent :: String -> (FilePath -> Session a) -> IO a +runWithExtraFilesMultiComponent dirName action = do + let vfs = mkIdeTestFs [copyDir dirName] + lspConfig :: Config + lspConfig = def { sessionLoading = PreferMultiComponentLoading } + conf :: TestConfig () + conf = def + { testPluginDescriptor = dummyPlugin + , testDirLocation = Right vfs + , testConfigCaps = lspTestCaps + , testShiftRoot = True + , testDisableKick = True + , testLspConfig = lspConfig + } + runSessionWithTestConfig conf action + +brokenMultiHieYaml :: T.Text +brokenMultiHieYaml = T.unlines + [ "cradle:" + , " cabal:" + , " - path: \"./a\"" + , " component: \"lib:a\"" + , " - path: \"./b\"" + , " component: \"lib:does-not-exist\"" + , " - path: \"./c\"" + , " component: \"lib:c\"" + ] + +writeBrokenMultiHieYaml :: FilePath -> Session () +writeBrokenMultiHieYaml dir = + liftIO $ atomicFileWriteStringUTF8 (dir "hie.yaml") (T.unpack brokenMultiHieYaml) + +notifyHieYamlChanged :: FilePath -> Session () +notifyHieYamlChanged dir = + sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams + [FileEvent (filePathToUri $ dir "hie.yaml") FileChangeType_Changed] + +assertTypeCheckSuccess :: TextDocumentIdentifier -> String -> Session () +assertTypeCheckSuccess doc msg = do + WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" doc + liftIO $ assertBool msg ideResultSuccess + +assertTypeCheckFailure :: TextDocumentIdentifier -> String -> Session () +assertTypeCheckFailure doc msg = do + WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" doc + liftIO $ assertBool msg (not ideResultSuccess) + +regressionBatchFailureIsolatesBrokenFile :: FilePath -> Session () +regressionBatchFailureIsolatesBrokenFile dir = do + writeBrokenMultiHieYaml dir + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + adoc <- openDoc aPath "haskell" + bdoc <- openDoc bPath "haskell" + _ <- waitForBuildQueue + [aRes, bRes] <- waitForTypeChecksBatched [adoc, bdoc] + liftIO $ assertBool "A should typecheck when B cradle mapping is broken" (ideResultSuccess aRes) + liftIO $ assertBool "B should fail with a broken cradle mapping" (not $ ideResultSuccess bRes) + +regressionFailedFileKeepsFailingUntilFix :: FilePath -> Session () +regressionFailedFileKeepsFailingUntilFix dir = do + writeBrokenMultiHieYaml dir + let aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + cPath = dir "c/C.hs" + bdoc <- openDoc bPath "haskell" + assertTypeCheckFailure bdoc "B should fail with broken cradle mapping" + + bSource <- liftIO $ readFileUtf8 bPath + changeDoc bdoc + [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ bSource <> "\n"] + assertTypeCheckFailure bdoc "B should keep failing until the cradle is fixed" + + adoc <- openDoc aPath "haskell" + cdoc <- openDoc cPath "haskell" + assertTypeCheckSuccess adoc "A should still typecheck while B remains broken" + assertTypeCheckSuccess cdoc "C should still typecheck while B remains broken" + +regressionFailedFileRecoversAfterFix :: FilePath -> Session () +regressionFailedFileRecoversAfterFix dir = do + let hiePath = dir "hie.yaml" + bPath = dir "b/B.hs" + validHie <- liftIO $ readFileUtf8 hiePath + writeBrokenMultiHieYaml dir + + bdoc <- openDoc bPath "haskell" + assertTypeCheckFailure bdoc "B should fail before fixing the cradle" + + liftIO $ atomicFileWriteStringUTF8 hiePath (T.unpack validHie) + notifyHieYamlChanged dir + + bSource <- liftIO $ readFileUtf8 bPath + changeDoc bdoc + [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ bSource <> "\n"] + assertTypeCheckSuccess bdoc "B should recover after restoring the cradle" + +regressionNoStaleOutcomesOnRestart :: FilePath -> Session () +regressionNoStaleOutcomesOnRestart dir = do + let hiePath = dir "hie.yaml" + aPath = dir "a/A.hs" + bPath = dir "b/B.hs" + cPath = dir "c/C.hs" + validHie <- liftIO $ readFileUtf8 hiePath + writeBrokenMultiHieYaml dir + + bdoc <- openDoc bPath "haskell" + assertTypeCheckFailure bdoc "B should fail before cradle fix" + + adoc <- openDoc aPath "haskell" + assertTypeCheckSuccess adoc "A should remain healthy while B is broken" + + liftIO $ atomicFileWriteStringUTF8 hiePath (T.unpack validHie) + notifyHieYamlChanged dir + + cdoc <- openDoc cPath "haskell" + assertTypeCheckSuccess cdoc "C should typecheck after cradle restart" + + bSource <- liftIO $ readFileUtf8 bPath + changeDoc bdoc + [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ bSource <> "\n"] + assertTypeCheckSuccess bdoc "B should not keep stale failure after cradle restart" -- Like simpleMultiTest but open the files in component 'a' in a separate session simpleMultiDefTest :: FilePath -> TestTree diff --git a/ghcide-test/exe/DiagnosticTests.hs b/ghcide-test/exe/DiagnosticTests.hs --- a/ghcide-test/exe/DiagnosticTests.hs +++ b/ghcide-test/exe/DiagnosticTests.hs @@ -9,7 +9,6 @@ import Control.Monad.IO.Class (liftIO) import Data.List.Extra import qualified Data.Text as T -import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Development.IDE.GHC.Util import Development.IDE.Test (diagnostic, expectCurrentDiagnostics, @@ -28,7 +27,6 @@ import Language.LSP.Test import System.Directory import System.FilePath -import System.IO.Extra hiding (withTempDir) import Config import Control.Lens ((^.)) diff --git a/ghcide-test/exe/FindDefinitionAndHoverTests.hs b/ghcide-test/exe/FindDefinitionAndHoverTests.hs --- a/ghcide-test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide-test/exe/FindDefinitionAndHoverTests.hs @@ -17,6 +17,7 @@ import Control.Lens ((^.)) import Development.IDE.Test (expectDiagnostics, standardizeQuotes) +import Hover import Test.Hls import Test.Hls.FileSystem (copyDir) import Text.Regex.TDFA ((=~)) @@ -90,16 +91,6 @@ _ -> liftIO $ assertFailure $ "expected: " <> show ("[...]" <> sourceFileName <> "::**[...]", Just expectedRange) <> "\n but got: " <> show (msg, rangeInHover) - - assertFoundIn :: T.Text -> T.Text -> Assertion - assertFoundIn part whole = assertBool - (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole) - (part `T.isInfixOf` whole) - - assertNotFoundIn :: T.Text -> T.Text -> Assertion - assertNotFoundIn part whole = assertBool - (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole) - (not . T.isInfixOf part $ whole) sourceFilePath = T.unpack sourceFileName sourceFileName = "GotoHover.hs" diff --git a/ghcide-test/exe/FindImplementationAndHoverTests.hs b/ghcide-test/exe/FindImplementationAndHoverTests.hs --- a/ghcide-test/exe/FindImplementationAndHoverTests.hs +++ b/ghcide-test/exe/FindImplementationAndHoverTests.hs @@ -14,6 +14,7 @@ import Config import Development.IDE.Test (standardizeQuotes) +import Hover import Test.Hls import Test.Hls.FileSystem (copyDir) @@ -47,16 +48,6 @@ _ -> pure () -- all other expectations not relevant to hover _ -> liftIO $ assertFailure $ "test not expecting this kind of hover info" <> show hover - assertFoundIn :: T.Text -> T.Text -> Assertion - assertFoundIn part whole = assertBool - (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole) - (part `T.isInfixOf` whole) - - assertNotFoundIn :: T.Text -> T.Text -> Assertion - assertNotFoundIn part whole = assertBool - (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole) - (not . T.isInfixOf part $ whole) - sourceFilePath = T.unpack sourceFileName sourceFileName = "GotoImplementation.hs" @@ -177,7 +168,7 @@ ] where yes :: (TestTree -> Maybe TestTree) yes = Just -- test should run and pass - no = const Nothing -- don't run this test at all + _no = const Nothing -- don't run this test at all -- ---------------------------------------------------------------------------- -- Helper functions for creating hover message verification diff --git a/ghcide-test/exe/Hover.hs b/ghcide-test/exe/Hover.hs new file mode 100644 --- /dev/null +++ b/ghcide-test/exe/Hover.hs @@ -0,0 +1,40 @@ +module Hover where + +import Config +import Control.Monad +import Data.Foldable +import qualified Data.Text as T +import Development.IDE.Test +import Test.Hls +import Text.Regex.TDFA + +assertFoundIn :: T.Text -> T.Text -> Assertion +assertFoundIn part whole = + assertBool + (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole) + (part `T.isInfixOf` whole) + +assertNotFoundIn :: T.Text -> T.Text -> Assertion +assertNotFoundIn part whole = + assertBool + (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole) + (not . T.isInfixOf part $ whole) + +checkHover :: (HasCallStack) => Maybe Hover -> [Expect] -> Session () +checkHover hover expectations = traverse_ check expectations + where + check :: (HasCallStack) => Expect -> Session () + check expected = + case hover of + Nothing -> unless (expected == ExpectNoHover) $ liftIO $ assertFailure "no hover found" + Just Hover{_contents = (InL MarkupContent{_value = standardizeQuotes -> msg}) + ,_range = _rangeInHover } -> + case expected of + ExpectRange _expectedRange -> liftIO $ assertFailure $ "ExpectRange assertion not implemented, yet." + ExpectHoverRange _expectedRange -> liftIO $ assertFailure $ "ExpectHoverRange assertion not implemented, yet." + ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets + ExpectHoverExcludeText snippets -> liftIO $ traverse_ (`assertNotFoundIn` msg) snippets + ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool) + ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover + _ -> pure () -- all other expectations not relevant to hover + _ -> liftIO $ assertFailure $ "test not expecting this kind of hover info" <> show hover diff --git a/ghcide-test/exe/IfaceTests.hs b/ghcide-test/exe/IfaceTests.hs --- a/ghcide-test/exe/IfaceTests.hs +++ b/ghcide-test/exe/IfaceTests.hs @@ -17,7 +17,6 @@ import Language.LSP.Test import System.Directory import System.FilePath -import System.IO.Extra hiding (withTempDir) import Test.Hls.FileSystem import Test.Tasty import Test.Tasty.HUnit diff --git a/ghcide-test/exe/InitializeResponseTests.hs b/ghcide-test/exe/InitializeResponseTests.hs --- a/ghcide-test/exe/InitializeResponseTests.hs +++ b/ghcide-test/exe/InitializeResponseTests.hs @@ -55,7 +55,14 @@ { _supported = Just True , _changeNotifications = Just (InR True) } - , _fileOperations = Nothing + , _fileOperations = Just $ FileOperationOptions + { _didCreate = Nothing + , _willCreate = Nothing + , _didRename = Nothing + , _willRename = Nothing + , _didDelete = Nothing + , _willDelete = Nothing + } }) , chk "NO experimental" (^. L.experimental) Nothing ] where @@ -89,4 +96,3 @@ release :: TResponseMessage Method_Initialize -> IO () release = mempty - diff --git a/ghcide-test/exe/Main.hs b/ghcide-test/exe/Main.hs --- a/ghcide-test/exe/Main.hs +++ b/ghcide-test/exe/Main.hs @@ -39,6 +39,7 @@ import ClientSettingsTests import CodeLensTests import CompletionTests +import ConstructorHoverTests import CPPTests import CradleTests import DependentFileTest @@ -79,6 +80,7 @@ , CodeLensTests.tests , OutlineTests.tests , HighlightTests.tests + , ConstructorHoverTests.tests , FindDefinitionAndHoverTests.tests , FindImplementationAndHoverTests.tests , PluginSimpleTests.tests diff --git a/ghcide-test/exe/THTests.hs b/ghcide-test/exe/THTests.hs --- a/ghcide-test/exe/THTests.hs +++ b/ghcide-test/exe/THTests.hs @@ -4,6 +4,7 @@ import Config import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T +import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Development.IDE.GHC.Util import Development.IDE.Test (expectCurrentDiagnostics, expectDiagnostics, @@ -18,8 +19,7 @@ tests :: TestTree tests = - testGroup - "TemplateHaskell" + testGroup "TemplateHaskell" $ [ -- Test for https://github.com/haskell/ghcide/pull/212 testWithDummyPluginEmpty "load" $ do let sourceA = @@ -104,6 +104,116 @@ _ <- openDoc cPath "haskell" expectDiagnostics [ ( cPath, [(DiagnosticSeverity_Warning, (3, 0), "Top-level binding with no type signature: a :: A", Just "GHC-38417")] ) ] ] + -- Regression test for GHC 9.14 ExplicitLevelImports. + -- Without level-aware module graph edges, HLS crashes with + -- `expectJust` in mgQueryZero when `import splice` is used. + ++ if ghcVersion >= GHC914 + then + [ testWithDummyPluginEmpty "ExplicitLevelImports-splice-import" $ do + let sourceA = + T.unlines + [ "{-# LANGUAGE TemplateHaskell #-}" + , "module A (a) where" + , "import Language.Haskell.TH" + , "a :: ExpQ" + , "a = [| 42 :: Int |]" + ] + sourceB = + T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "{-# LANGUAGE ExplicitLevelImports #-}" + , "{-# LANGUAGE TemplateHaskell #-}" + , "module B where" + , "import splice A (a)" + , "b :: Int" + , "b = $a" + , "dummy = 5 :: Int" + ] + _ <- createDoc "A.hs" "haskell" sourceA + _ <- createDoc "B.hs" "haskell" sourceB + expectDiagnostics [ ( "B.hs", [(DiagnosticSeverity_Warning, (7, 0), "Top-level binding with no type signature: dummy :: Int", Just "GHC-38417")] ) ] + , testWithDummyPluginEmpty "ExplicitLevelImports-dual-import" $ do + let sourceM = + T.unlines + [ "{-# LANGUAGE TemplateHaskell #-}" + , "module M (m) where" + , "import Language.Haskell.TH" + , "m :: ExpQ" + , "m = [| 100 :: Int |]" + ] + sourceC = + T.unlines + [ "{-# OPTIONS_GHC -Wmissing-signatures #-}" + , "{-# LANGUAGE ExplicitLevelImports #-}" + , "{-# LANGUAGE TemplateHaskell #-}" + , "module C where" + , "import splice M (m)" + , "import M (m)" -- Normal import alongside splice import + , "c :: Int" + , "c = $m" + , "dummy = 5 :: Int" + ] + _ <- createDoc "M.hs" "haskell" sourceM + _ <- createDoc "C.hs" "haskell" sourceC + expectDiagnostics [ ( "C.hs", [(DiagnosticSeverity_Warning, (8, 0), "Top-level binding with no type signature: dummy :: Int", Just "GHC-38417")] ) ] + , testWithDummyPluginEmpty "ExplicitLevelImports-redundant-mix" $ do + let sourceM = + T.unlines + [ "{-# LANGUAGE TemplateHaskell #-}" + , "module M (m) where" + , "import Language.Haskell.TH" + , "m :: ExpQ" + , "m = [| 1 :: Int |]" + ] + sourceD = + T.unlines + [ "{-# OPTIONS_GHC -Wmissing-signatures #-}" + , "{-# LANGUAGE ExplicitLevelImports #-}" + , "{-# LANGUAGE TemplateHaskell #-}" + , "module D where" + , "import splice M" + , "import M" + , "import splice M" -- Redundant splice import + , "d :: Int" + , "d = $m" + , "dummy = 5 :: Int" + ] + _ <- createDoc "M.hs" "haskell" sourceM + _ <- createDoc "D.hs" "haskell" sourceD + expectDiagnostics [ ( "D.hs", [(DiagnosticSeverity_Warning, (9, 0), "Top-level binding with no type signature: dummy :: Int", Just "GHC-38417")] ) ] + , testWithDummyPluginEmpty "ExplicitLevelImports-transitive" $ do + let sourceBase = + T.unlines + [ "{-# LANGUAGE TemplateHaskell #-}" + , "module BaseTH (baseMacro) where" + , "import Language.Haskell.TH" + , "baseMacro :: ExpQ" + , "baseMacro = [| 50 :: Int |]" + ] + sourceInter = + T.unlines + [ "{-# LANGUAGE ExplicitLevelImports #-}" + , "{-# LANGUAGE TemplateHaskell #-}" + , "module Intermediate where" + , "import splice BaseTH" -- Splice import here + , "interVal :: Int" + , "interVal = $baseMacro" + ] + sourceConsumer = + T.unlines + [ "{-# OPTIONS_GHC -Wall #-}" + , "module Consumer where" + , "import Intermediate" -- Normal import here + , "cons :: Int" + , "cons = interVal" + , "dummy = 5 :: Int" + ] + _ <- createDoc "BaseTH.hs" "haskell" sourceBase + _ <- createDoc "Intermediate.hs" "haskell" sourceInter + _ <- createDoc "Consumer.hs" "haskell" sourceConsumer + expectDiagnostics [ ( "Consumer.hs", [(DiagnosticSeverity_Warning, (5, 0), "Top-level binding with no type signature: dummy :: Int", Just "GHC-38417")] ) ] + ] + else [] -- | Test that all modules have linkables @@ -147,7 +257,7 @@ expectDiagnostics [("THC.hs", [(DiagnosticSeverity_Error, (4, 4), "Couldn't match expected type '()' with actual type 'Bool'", Just "GHC-83865")]) ,("THC.hs", [(DiagnosticSeverity_Warning, (6,0), "Top-level binding", Just "GHC-38417")]) - ,("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level bindin", Just "GHC-38417")]) + ,("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level binding", Just "GHC-38417")]) ] closeDoc adoc diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1,7 +1,7 @@ cabal-version: 3.4 category: Development name: haskell-language-server -version: 2.13.0.0 +version: 2.14.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at @@ -14,7 +14,7 @@ license: Apache-2.0 license-file: LICENSE build-type: Simple -tested-with: GHC == {9.12.2, 9.10.2, 9.8.4, 9.6.7} +tested-with: GHC == {9.14.1, 9.12.2, 9.10.3, 9.8.4, 9.6.7} extra-source-files: README.md ChangeLog.md @@ -136,8 +136,8 @@ build-depends: , directory , filepath - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp-types , mtl @@ -157,8 +157,8 @@ , filepath , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-fmt-plugin - , hls-plugin-api == 2.13.0.0 - , hls-test-utils == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 + , hls-test-utils == 2.14.0.0 if flag(isolateCabalfmtTests) build-tool-depends: cabal-fmt:cabal-fmt ^>=0.1.12 @@ -193,8 +193,8 @@ build-depends: , directory , filepath - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp-types , text , mtl @@ -213,8 +213,8 @@ , filepath , haskell-language-server:hls-cabal-plugin , haskell-language-server:hls-cabal-gild-plugin - , hls-plugin-api == 2.13.0.0 - , hls-test-utils == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 + , hls-test-utils == 2.14.0.0 if flag(isolateCabalGildTests) -- https://github.com/tfausak/cabal-gild/issues/89 @@ -274,13 +274,13 @@ , directory , filepath , extra >=1.7.4 - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable - , hls-plugin-api == 2.13.0.0 - , hls-graph == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 + , hls-graph == 2.14.0.0 , lens - , lsp ^>=2.7 - , lsp-types ^>=2.3 + , lsp ^>=2.8 + , lsp-types ^>=2.4 , mtl , regex-tdfa ^>=1.3.1 , text @@ -316,7 +316,7 @@ , filepath , ghcide , haskell-language-server:hls-cabal-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -353,9 +353,9 @@ , extra , ghc , ghc-exactprint >= 1.5 && < 1.15 - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hls-graph - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , mtl @@ -376,7 +376,7 @@ build-depends: , filepath , haskell-language-server:hls-class-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -411,11 +411,11 @@ , containers , extra , ghc - , ghcide == 2.13.0.0 - , hiedb ^>= 0.7.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hiedb ^>= 0.8.0.0 + , hls-plugin-api == 2.14.0.0 , lens - , lsp >=2.7 + , lsp >=2.8 , sqlite-simple , text @@ -434,7 +434,7 @@ , extra , filepath , haskell-language-server:hls-call-hierarchy-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp , lsp-test @@ -484,9 +484,9 @@ , filepath , ghc , ghc-boot-th - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hls-graph - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , lsp-types @@ -517,7 +517,7 @@ , filepath , haskell-language-server:hls-eval-plugin , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -547,9 +547,9 @@ , containers , deepseq , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hls-graph - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , mtl @@ -570,7 +570,7 @@ , extra , filepath , haskell-language-server:hls-explicit-imports-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -593,15 +593,19 @@ import: defaults, pedantic, warnings if !flag(rename) buildable: False - exposed-modules: Ide.Plugin.Rename + exposed-modules: + Ide.Plugin.Rename + Ide.Plugin.Rename.ModuleName hs-source-dirs: plugins/hls-rename-plugin/src build-depends: + , aeson , containers + , filepath , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable - , hiedb ^>= 0.7.0.0 - , hls-plugin-api == 2.13.0.0 + , hiedb ^>= 0.8.0.0 + , hls-plugin-api == 2.14.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp-types @@ -609,6 +613,7 @@ , mod , syb , text + , text-rope , transformers , unordered-containers @@ -626,7 +631,7 @@ , filepath , hls-plugin-api , haskell-language-server:hls-rename-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -657,9 +662,9 @@ , containers , extra , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp @@ -688,7 +693,7 @@ , filepath , hls-plugin-api , haskell-language-server:{hls-refactor-plugin, hls-retrie-plugin} - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , text ----------------------------- @@ -732,10 +737,10 @@ , containers , deepseq , filepath - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable , hlint >= 3.5 && < 3.11 - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens , mtl , refact @@ -788,7 +793,7 @@ , filepath , haskell-language-server:hls-hlint-plugin , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -842,7 +847,7 @@ , filepath , haskell-language-server:hls-stan-plugin , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -876,8 +881,8 @@ build-depends: , containers , ghc - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp-types , text , transformers @@ -893,60 +898,13 @@ build-depends: , ghcide , haskell-language-server:hls-signature-help-plugin - , hls-test-utils == 2.13.0.0 - , lens - , lsp-types - , string-interpolate + , hls-test-utils == 2.14.0.0 , text default-extensions: DerivingStrategies OverloadedStrings ----------------------------- --- module name plugin ------------------------------ - -flag moduleName - description: Enable moduleName plugin - default: True - manual: True - -common moduleName - if flag(moduleName) - build-depends: haskell-language-server:hls-module-name-plugin - cpp-options: -Dhls_moduleName - -library hls-module-name-plugin - import: defaults, pedantic, warnings - if !flag(modulename) - buildable: False - exposed-modules: Ide.Plugin.ModuleName - hs-source-dirs: plugins/hls-module-name-plugin/src - build-depends: - , aeson - , containers - , filepath - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 - , lsp - , text - , text-rope - , transformers - - -test-suite hls-module-name-plugin-tests - import: defaults, pedantic, test-defaults, warnings - if !flag(modulename) - buildable: False - type: exitcode-stdio-1.0 - hs-source-dirs: plugins/hls-module-name-plugin/test - main-is: Main.hs - build-depends: - , filepath - , haskell-language-server:hls-module-name-plugin - , hls-test-utils == 2.13.0.0 - ------------------------------ -- pragmas plugin ----------------------------- @@ -970,13 +928,11 @@ , aeson , extra , fuzzy - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens - , lens-aeson , lsp , text - , transformers , containers test-suite hls-pragmas-plugin-tests @@ -990,7 +946,7 @@ , aeson , filepath , haskell-language-server:hls-pragmas-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-types , text @@ -1023,8 +979,8 @@ , extra , foldl , ghc - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , haskell-language-server:hls-refactor-plugin , lens , lsp @@ -1047,7 +1003,7 @@ build-depends: , filepath , haskell-language-server:hls-splice-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , text ----------------------------- @@ -1074,12 +1030,12 @@ build-depends: , containers , extra - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , ghc-boot-th , hls-graph - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens - , lsp ^>=2.7 + , lsp ^>=2.8 , mtl , syb , text @@ -1102,7 +1058,7 @@ , containers , filepath , haskell-language-server:hls-alternate-number-format-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , regex-tdfa , tasty-quickcheck , text @@ -1135,8 +1091,8 @@ build-depends: , containers , ghc - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , text @@ -1158,7 +1114,7 @@ , text , filepath , haskell-language-server:hls-qualify-imported-names-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 ----------------------------- -- code range plugin @@ -1189,9 +1145,9 @@ , deepseq , extra , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , mtl @@ -1213,7 +1169,7 @@ , bytestring , filepath , haskell-language-server:hls-code-range-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp , lsp-test @@ -1241,8 +1197,8 @@ exposed-modules: Ide.Plugin.ChangeTypeSignature hs-source-dirs: plugins/hls-change-type-signature-plugin/src build-depends: - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp-types , regex-tdfa @@ -1268,8 +1224,7 @@ build-depends: , filepath , haskell-language-server:hls-change-type-signature-plugin - , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , regex-tdfa , text default-extensions: @@ -1302,12 +1257,12 @@ , containers , extra , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , ghc-exactprint - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , haskell-language-server:hls-refactor-plugin , lens - , lsp >=2.7 + , lsp >=2.8 , mtl , text , transformers @@ -1324,7 +1279,7 @@ build-depends: , filepath , haskell-language-server:hls-gadt-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , text ----------------------------- @@ -1351,10 +1306,10 @@ , containers , deepseq , extra - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , hashable - , hls-plugin-api == 2.13.0.0 - , lsp >=2.7 + , hls-plugin-api == 2.14.0.0 + , lsp >=2.8 , text default-extensions: DataKinds @@ -1369,7 +1324,7 @@ build-depends: , filepath , haskell-language-server:hls-explicit-fixity-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , text ----------------------------- @@ -1393,8 +1348,8 @@ exposed-modules: Ide.Plugin.ExplicitFields build-depends: , ghc - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp , lens , hls-graph @@ -1420,7 +1375,7 @@ , text , ghcide , haskell-language-server:hls-explicit-record-fields-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 ----------------------------- -- overloaded record dot plugin @@ -1466,52 +1421,10 @@ , filepath , text , haskell-language-server:hls-overloaded-record-dot-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 ----------------------------- --- floskell plugin ------------------------------ - -flag floskell - description: Enable floskell plugin - default: True - manual: True - -common floskell - if flag(floskell) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)) - build-depends: haskell-language-server:hls-floskell-plugin - cpp-options: -Dhls_floskell - -library hls-floskell-plugin - import: defaults, pedantic, warnings - -- https://github.com/ennocramer/floskell/pull/82 - if !(flag(floskell) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))) - buildable: False - exposed-modules: Ide.Plugin.Floskell - hs-source-dirs: plugins/hls-floskell-plugin/src - build-depends: - , floskell ^>=0.11.0 - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 - , lsp-types ^>=2.3 - , mtl - , text - - -test-suite hls-floskell-plugin-tests - import: defaults, pedantic, test-defaults, warnings - if !(flag(floskell) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))) - buildable: False - type: exitcode-stdio-1.0 - hs-source-dirs: plugins/hls-floskell-plugin/test - main-is: Main.hs - build-depends: - , filepath - , haskell-language-server:hls-floskell-plugin - , hls-test-utils == 2.13.0.0 - ------------------------------ -- fourmolu plugin ----------------------------- @@ -1537,8 +1450,8 @@ , filepath , fourmolu ^>= 0.14 || ^>= 0.15 || ^>= 0.16 || ^>=0.17 || ^>=0.18 || ^>=0.19 , ghc-boot-th - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens , lsp , mtl @@ -1562,11 +1475,15 @@ fourmolu:fourmolu build-depends: , aeson + , containers , filepath , haskell-language-server:hls-fourmolu-plugin , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 + , lens , lsp-test + , lsp-types + , text ----------------------------- -- ormolu plugin @@ -1594,8 +1511,8 @@ , extra , filepath , ghc-boot-th - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp , mtl , process-extras >= 0.7.1 @@ -1619,12 +1536,15 @@ ormolu:ormolu build-depends: , aeson + , containers , filepath , haskell-language-server:hls-ormolu-plugin , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 + , lens , lsp-types , ormolu + , text ----------------------------- -- stylish-haskell plugin @@ -1653,8 +1573,8 @@ , directory , filepath , ghc-boot-th - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp-types , mtl , stylish-haskell >=0.12 && <0.16 @@ -1672,7 +1592,7 @@ build-depends: , filepath , haskell-language-server:hls-stylish-haskell-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 ----------------------------- -- refactor plugin @@ -1724,8 +1644,8 @@ , bytestring , ghc-boot , regex-tdfa - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lsp , text , text-rope @@ -1741,9 +1661,6 @@ , mtl , lens , time - -- FIXME: Only needed to workaround for qualified imports in GHC 9.4 - , regex-applicative - , parser-combinators if impl(ghc < 9.10) build-depends: data-default @@ -1763,7 +1680,7 @@ , filepath , ghcide:ghcide , haskell-language-server:hls-refactor-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-test , lsp-types @@ -1771,7 +1688,6 @@ , regex-tdfa , shake , tasty - , tasty-expected-failure , tasty-hunit , text @@ -1811,18 +1727,17 @@ , text-rope , mtl >= 2.2 , ghc - , ghcide == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens - , lsp >=2.6 + , lsp >=2.8 , text , transformers , bytestring - , syb , array , deepseq , dlist - , hls-graph == 2.13.0.0 + , hls-graph == 2.14.0.0 , template-haskell , data-default , stm @@ -1843,10 +1758,10 @@ , containers , data-default , filepath - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , haskell-language-server:hls-semantic-tokens-plugin - , hls-plugin-api == 2.13.0.0 - , hls-test-utils == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp , lsp-test @@ -1876,11 +1791,11 @@ hs-source-dirs: plugins/hls-notes-plugin/src build-depends: , array - , ghcide == 2.13.0.0 - , hls-graph == 2.13.0.0 - , hls-plugin-api == 2.13.0.0 + , ghcide == 2.14.0.0 + , hls-graph == 2.14.0.0 + , hls-plugin-api == 2.14.0.0 , lens - , lsp >=2.7 + , lsp >=2.8 , mtl >= 2.2 , regex-tdfa >= 1.3.1 , text @@ -1904,7 +1819,7 @@ build-depends: , filepath , haskell-language-server:hls-notes-plugin - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 default-extensions: OverloadedStrings ---------------------------- @@ -1931,7 +1846,6 @@ , hlint , stan , signatureHelp - , moduleName , pragmas , splice , alternateNumberFormat @@ -1940,7 +1854,6 @@ , gadt , explicitFixity , explicitFields - , floskell , fourmolu , ormolu , stylishHaskell @@ -1965,10 +1878,10 @@ , extra , filepath , ghc - , ghcide == 2.13.0.0 + , ghcide == 2.14.0.0 , githash >=0.1.6.1 , hie-bios - , hls-plugin-api == 2.13.0.0 + , hls-plugin-api == 2.14.0.0 , optparse-applicative , optparse-simple , prettyprinter >= 1.7 @@ -2071,7 +1984,7 @@ , ghcide:ghcide , hashable , hls-plugin-api - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , lens , lsp-test , lsp-types @@ -2097,8 +2010,6 @@ if flag(eval) cpp-options: -Dhls_eval -- formatters - if flag(floskell) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)) - cpp-options: -Dhls_floskell if flag(fourmolu) && (impl(ghc < 9.14) || flag(ignore-plugins-ghc-bounds)) cpp-options: -Dhls_fourmolu if flag(ormolu) && (impl(ghc < 9.14) || flag(ignore-plugins-ghc-bounds)) @@ -2115,7 +2026,7 @@ build-depends: , extra - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 , process hs-source-dirs: test/wrapper @@ -2189,7 +2100,7 @@ , lens , list-t , lsp - , lsp-test ^>=0.17.1 + , lsp-test ^>=0.18.0 , lsp-types , mtl , network-uri @@ -2208,7 +2119,7 @@ , text , text-rope , unordered-containers - , hls-test-utils == 2.13.0.0 + , hls-test-utils == 2.14.0.0 if impl(ghc <9.3) build-depends: ghc-typelits-knownnat @@ -2224,6 +2135,7 @@ ClientSettingsTests CodeLensTests CompletionTests + ConstructorHoverTests CPPTests CradleTests DependentFileTest @@ -2236,6 +2148,7 @@ HaddockTests HieDbRetry HighlightTests + Hover IfaceTests InitializeResponseTests LogType @@ -2346,7 +2259,7 @@ build-depends: extra, haskell-language-server:ghcide-bench-lib, - lsp-test ^>= 0.17, + lsp-test ^>= 0.18, tasty, tasty-hunit >= 0.10, tasty-rerun diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd/CodeAction.hs @@ -36,6 +36,8 @@ PluginId) import Control.Lens ((^.)) +import qualified Data.Aeson as Aeson +import Development.IDE.Session.Diagnostics import qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Protocol.Types (CodeActionKind (..), VersionedTextDocumentIdentifier) @@ -43,7 +45,6 @@ import System.FilePath import Text.PrettyPrint (render) import Text.Regex.TDFA - -------------------------------------------- -- Add module to cabal file -------------------------------------------- @@ -148,13 +149,16 @@ cabalSrcPath = takeDirectory cabalSrcPath' isUnknownModuleDiagnostic :: J.Diagnostic -> Bool -isUnknownModuleDiagnostic diag = (msg =~ regex) - where - msg :: T.Text - msg = diag ^. JL.message - regex :: T.Text - regex = "Loading the module [\8216'][^\8217']*[\8217'] failed." - +isUnknownModuleDiagnostic diag = + case diag ^. JL.data_ of + Nothing -> False + Just v -> + case Aeson.fromJSON v of + Aeson.Success details -> + case structuredCradleError details of + Just (UnknownModuleError _) -> True + _ -> False + _ -> False -------------------------- -- Below are several utility functions which create a StanzaItem for each of the possible Stanzas, -- these all have specific constructors we need to match, so we can't generalise this process well. diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs @@ -5,6 +5,8 @@ import Control.Exception (evaluate, try) import Control.Monad (filterM) import Control.Monad.Extra (concatForM, forM) +import Data.Char (isUpper) +import Data.List (find) import qualified Data.Text as T import Distribution.PackageDescription (GenericPackageDescription) import Ide.Logger @@ -26,50 +28,39 @@ let prefInfo = cabalPrefixInfo cData complInfo = pathCompletionInfoFromCabalPrefixInfo "" prefInfo filePathCompletions <- listFileCompletions recorder complInfo - let scored = - Fuzzy.simpleFilter - Fuzzy.defChunkSize - Fuzzy.defMaxResults - (pathSegment complInfo) - (map T.pack filePathCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - fullFilePath <- mkFilePathCompletion complInfo compl - pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath - ) + let query = pathSegment complInfo + originals = map T.pack filePathCompletions + matched = smartCaseFuzzy query originals + forM matched $ \compl -> do + fullFilePath <- mkFilePathCompletion complInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + mainIsCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer mainIsCompleter extractionFunction recorder cData = do mGPD <- getLatestGPD cData case mGPD of Just gpd -> do - let srcDirs = extractionFunction sName gpd - concatForM srcDirs - (\dir' -> do + concatForM srcDirs $ \dir' -> do let dir = FP.normalise dir' - let pathInfo = pathCompletionInfoFromCabalPrefixInfo dir prefInfo + pathInfo = pathCompletionInfoFromCabalPrefixInfo dir prefInfo + query = pathSegment pathInfo + completions <- listFileCompletions recorder pathInfo - let scored = Fuzzy.simpleFilter - Fuzzy.defChunkSize - Fuzzy.defMaxResults - (pathSegment pathInfo) - (map T.pack completions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - fullFilePath <- mkFilePathCompletion pathInfo compl - pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath - ) - ) + + let originals = map T.pack completions + matched = smartCaseFuzzy query originals + + forM matched $ \compl -> do + fullFilePath <- mkFilePathCompletion pathInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + where + sName = stanzaName cData + srcDirs = extractionFunction sName gpd + prefInfo = cabalPrefixInfo cData Nothing -> do logWith recorder Debug LogUseWithStaleFastNoResult pure [] - where - sName = stanzaName cData - prefInfo = cabalPrefixInfo cData -- | Completer to be used when a directory can be completed for the field. @@ -79,20 +70,14 @@ let prefInfo = cabalPrefixInfo cData complInfo = pathCompletionInfoFromCabalPrefixInfo "" prefInfo directoryCompletions <- listDirectoryCompletions recorder complInfo - let scored = - Fuzzy.simpleFilter - Fuzzy.defChunkSize - Fuzzy.defMaxResults - (pathSegment complInfo) - (map T.pack directoryCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - let fullDirPath = mkPathCompletionDir complInfo compl - pure $ mkCompletionItem (completionRange prefInfo) fullDirPath fullDirPath - ) + let query = pathSegment complInfo + originals = map T.pack directoryCompletions + matched = smartCaseFuzzy query originals + forM matched $ \compl -> do + fullFilePath <- mkFilePathCompletion complInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + {- Note [Using correct file path separators] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Since cabal files only allow for posix style file paths @@ -185,3 +170,49 @@ isFilePath <- doesFileExist $ T.unpack combinedPath let completedPath = if isFilePath then applyStringNotation (isStringNotationPath complInfo) combinedPath else combinedPath pure completedPath + +-- | Applies smart-case filtering to fuzzy-matched candidates. +-- If the query contains uppercase characters, candidates must +-- contain the query as a case-sensitive substring. +-- If the query is all lowercase, all fuzzy matches are accepted. +smartCaseFuzzy :: T.Text -> [T.Text] -> [T.Text] +smartCaseFuzzy query originals = + let smartSensitive :: Bool + smartSensitive = T.any isUpper query + + filtered :: [T.Text] + filtered + | smartSensitive = filter (isCaseSensitiveSubsequence query) originals + | otherwise =originals + + pairs :: [(T.Text, T.Text)] + pairs = [ (o, T.toLower o) | o <- filtered ] + + matchQuery :: T.Text + matchSpace :: [T.Text] + (matchQuery, matchSpace) = + if smartSensitive + then (query, map fst pairs) + else (T.toLower query, map snd pairs) + + scored :: [Fuzzy.Scored T.Text] + scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults matchQuery matchSpace + + restore :: T.Text -> T.Text + restore matched = + case find (\(o,l) -> o == matched || l == matched) pairs of + Just (o, _) -> o + Nothing -> matched + in + map (restore . Fuzzy.original) scored + +-- | Checks whether the query is a case-sensitive subsequence of the candidate. +-- Characters must appear in order and match exactly (including case). +isCaseSensitiveSubsequence :: T.Text -> T.Text -> Bool +isCaseSensitiveSubsequence q c = go (T.unpack q) (T.unpack c) + where + go [] _ = True + go _ [] = False + go (x:xs) (y:ys) + | x == y = go xs ys + | otherwise = go (x:xs) ys diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -14,14 +14,14 @@ WithPriority, logWith) import Ide.Plugin.Cabal.Completion.Completer.FilePath (listFileCompletions, - mkCompletionDirectory) + mkCompletionDirectory, + smartCaseFuzzy) import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types import System.Directory (doesFileExist) import qualified System.FilePath as FP -import qualified Text.Fuzzy.Parallel as Fuzzy -- | Completer to be used when module paths can be completed for the field. -- @@ -50,7 +50,7 @@ -> CabalPrefixInfo -> Matcher T.Text -> IO [T.Text] -filePathsForExposedModules recorder srcDirs prefInfo matcher = do +filePathsForExposedModules recorder srcDirs prefInfo _matcher = do concatForM srcDirs ( \dir' -> do @@ -58,18 +58,17 @@ pathInfo = pathCompletionInfoFromCabalPrefixInfo dir modPrefInfo completions <- listFileCompletions recorder pathInfo validExposedCompletions <- filterM (isValidExposedModulePath pathInfo) completions - let toMatch = pathSegment pathInfo - scored = runMatcher - matcher - toMatch - (map T.pack validExposedCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - fullFilePath <- mkExposedModulePathCompletion pathInfo $ T.unpack compl - pure fullFilePath - ) + + let query = pathSegment pathInfo + candidates :: [T.Text] + candidates = map T.pack validExposedCompletions + + matched :: [T.Text] + matched = smartCaseFuzzy query candidates + + forM matched $ \compl -> do + fullFilePath <- mkExposedModulePathCompletion pathInfo (T.unpack compl) + pure fullFilePath ) where prefix = diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs @@ -88,7 +88,8 @@ ("common", libExecTestBenchCommons Library), ("common", libExecTestBenchCommons Common), ("flag", flagFields), - ("source-repository", sourceRepositoryFields) + ("source-repository", sourceRepositoryFields), + ("custom-setup", customSetupFields) ] libraryFields :: Map KeyWordName Completer @@ -180,7 +181,7 @@ ("hs-source-dirs:", directoryCompleter), ("default-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions), ("other-extensions:", constantCompleter $ map (T.pack . prettyShow) allExtensions), - ("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]), + ("default-language:", defaultLanguageCompleter), ("other-languages:", noopCompleter), ("build-tool-depends:", noopCompleter), ("buildable:", constantCompleter ["True", "False"]), @@ -236,6 +237,15 @@ -- but not have erased the "common" stanza. noopCompleter +customSetupFields :: Map KeyWordName Completer +customSetupFields = + Map.fromList + [ ("setup-depends:", noopCompleter) + , ("build-depends:", noopCompleter) + , ("build-tools:", noopCompleter) + , ("default-language:", defaultLanguageCompleter) + ] + -- | Returns all possible language extensions including disabled ones. allExtensions :: [Extension] allExtensions = @@ -249,6 +259,10 @@ ) knownExtensions +-- | Returns all possible default languages +defaultLanguageCompleter :: Completer +defaultLanguageCompleter = constantCompleter $ map (T.pack . prettyShow) knownLanguages + -- | Contains a map of the most commonly used licenses, weighted by their popularity. -- -- The data was extracted by Kleidukos from the alternative hackage frontend flora.pm. @@ -309,3 +323,4 @@ ghcOptions :: [T.Text] ghcOptions = map T.pack $ flagsForCompletion False + diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -101,16 +101,19 @@ "File Completer Tests" [ testCase "Current Directory - no leading ./ by default" $ do completions <- completeFilePath "" filePathComplTestDir - completions @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], + completions @?== [".hidden", "Content.hs", "Dir4/", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], testCase "Current Directory - alternative writing" $ do completions <- completeFilePath "./" filePathComplTestDir - completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], + completions @?== ["./.hidden", "./Content.hs", "./Dir4/", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - hidden file start" $ do completions <- completeFilePath "." filePathComplTestDir completions @?== ["Content.hs", ".hidden", "textfile.txt", "main-is.cabal"], testCase "Current Directory - incomplete directory path written" $ do completions <- completeFilePath "di" filePathComplTestDir - completions @?== ["dir1/", "dir2/"], + completions @?== ["dir1/", "dir2/","Dir4/"], + testCase "Current Directory - fuzzy Smart casing" $ do + completions <- completeFilePath "Dr" filePathComplTestDir + completions @?== ["Dir4/"], testCase "Current Directory - incomplete filepath written" $ do completions <- completeFilePath "te" filePathComplTestDir completions @?== ["Content.hs", "textfile.txt"], @@ -120,6 +123,12 @@ testCase "Subdirectory - incomplete filepath written" $ do completions <- completeFilePath "dir2/dir3/MA" filePathComplTestDir completions @?== ["dir2/dir3/MARKDOWN.md"], + testCase "Subdirectory - lowerCase" $ do + completions <- completeFilePath "dir2/dir3/md" filePathComplTestDir + completions @?== ["dir2/dir3/MARKDOWN.md"], + testCase "Subdirectory - smart casing mismatch" $ do + completions <- completeFilePath "dir2/dir3/Ma" filePathComplTestDir + completions @?== [], testCase "Nonexistent directory" $ do completions <- completeFilePath "dir2/dir4/" filePathComplTestDir completions @?== [] @@ -171,7 +180,7 @@ queryDirectory = "", workingDirectory = filePathComplTestDir } - compls @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], + compls @?== [".hidden", "Content.hs", "Dir4/", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], testCase "In directory" $ do compls <- listFileCompletions @@ -200,13 +209,19 @@ "Directory Completer Tests" [ testCase "Current Directory - no leading ./ by default" $ do completions <- completeDirectory "" filePathComplTestDir - completions @?== ["dir1/", "dir2/"], + completions @?== ["Dir4/", "dir1/", "dir2/"], testCase "Current Directory - alternative writing" $ do completions <- completeDirectory "./" filePathComplTestDir - completions @?== ["./dir1/", "./dir2/"], + completions @?== ["./Dir4/", "./dir1/", "./dir2/"], testCase "Current Directory - incomplete directory path written" $ do - completions <- completeDirectory "di" filePathComplTestDir - completions @?== ["dir1/", "dir2/"], + completions <- completeDirectory "dr" filePathComplTestDir + completions @?== ["Dir4/", "dir1/", "dir2/"], + testCase "Current Directory - correct smart casing" $ do + completions <- completeDirectory "Dr" filePathComplTestDir + completions @?== ["Dir4/"], + testCase "Current Directory - incorrect smart casing" $ do + completions <- completeDirectory "DI" filePathComplTestDir + completions @?== [], testCase "Current Directory - incomplete filepath written" $ do completions <- completeDirectory "te" filePathComplTestDir completions @?== [], @@ -315,7 +330,16 @@ completions @?== ["File3"], testCase "Name nothing but not library" $ do completions <- callModulesCompleter Nothing sourceDirsExtractionTestSuite "3" - completions @?== [] + completions @?== [], + testCase "Exposed modules - smart casing rejects mixed-case mismatch" $ do + completions <- callModulesCompleter (Just "benchie") sourceDirsExtractionBenchmark "FL" + completions @?== [], + testCase "Exposed modules - smart casing preserves fuzzy matching" $ do + completions <- callModulesCompleter (Just "benchie") sourceDirsExtractionBenchmark "Fl1" + completions @?== ["File1"], + testCase "Exposed modules - lowercase remains case-insensitive" $ do + completions <- callModulesCompleter (Just "benchie") sourceDirsExtractionBenchmark "fl" + completions @?== ["File1"] ] where callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text] diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -16,6 +16,7 @@ import qualified Language.LSP.Test as Test import System.FilePath import Test.Hls +import qualified Test.Hls.FileSystem as FS plugin :: PluginTestDescriptor () plugin = mkPluginTestDescriptor' descriptor "call-hierarchy" @@ -192,9 +193,9 @@ testGroup "Incoming Calls" [ testGroup "single file" [ testCase "xdata unavailable" $ - runSessionWithServer def plugin testDataDir $ do + runCallHierarchySessionEmpty $ do doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"] - waitForIndex (testDataDir "A.hs") + waitForIndex "A.hs" item <- expectOneElement =<< Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0) let expected = [CallHierarchyIncomingCall item [mkRange 1 2 1 3]] item' <- expectOneElement =<< Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 0) @@ -312,10 +313,10 @@ outgoingCallsTests = testGroup "Outgoing Calls" [ testGroup "single file" - [ testCase "xdata unavailable" $ withCanonicalTempDir $ \dir -> - runSessionWithServer def plugin dir $ do + [ testCase "xdata unavailable" $ + runCallHierarchySessionEmpty $ do doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"] - waitForIndex (dir "A.hs") + waitForIndex "A.hs" item <- expectOneElement =<< Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 1) let expected = [CallHierarchyOutgoingCall item [mkRange 1 2 1 3]] item' <- expectOneElement =<< Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0) @@ -411,10 +412,10 @@ incomingCallTestCase :: T.Text -> Int -> Int -> [(Int, Int)] -> [Range] -> Assertion -incomingCallTestCase contents queryX queryY positions ranges = withCanonicalTempDir $ \dir -> - runSessionWithServer def plugin dir $ do +incomingCallTestCase contents queryX queryY positions ranges = + runCallHierarchySessionEmpty $ do doc <- createDoc "A.hs" "haskell" contents - waitForIndex (dir "A.hs") + waitForIndex "A.hs" items <- concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc x y) <&> map (, range) @@ -428,9 +429,9 @@ incomingCallMultiFileTestCase :: FilePath -> Int -> Int -> M.Map FilePath [((Int, Int), Range)] -> Assertion incomingCallMultiFileTestCase filepath queryX queryY mp = - runSessionWithServer def plugin testDataDir $ do + runCallHierarchySession $ do doc <- openDoc filepath "haskell" - waitForIndex (testDataDir filepath) + waitForIndex filepath items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr -> do p <- openDoc fp "haskell" waitForKickDone @@ -445,10 +446,10 @@ closeDoc doc outgoingCallTestCase :: T.Text -> Int -> Int -> [(Int, Int)] -> [Range] -> Assertion -outgoingCallTestCase contents queryX queryY positions ranges = withCanonicalTempDir $ \dir -> - runSessionWithServer def plugin dir $ do +outgoingCallTestCase contents queryX queryY positions ranges = + runCallHierarchySessionEmpty $ do doc <- createDoc "A.hs" "haskell" contents - waitForIndex (dir "A.hs") + waitForIndex "A.hs" items <- concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc x y) <&> map (, range) @@ -462,9 +463,9 @@ outgoingCallMultiFileTestCase :: FilePath -> Int -> Int -> M.Map FilePath [((Int, Int), Range)] -> Assertion outgoingCallMultiFileTestCase filepath queryX queryY mp = - runSessionWithServer def plugin testDataDir $ do + runCallHierarchySession $ do doc <- openDoc filepath "haskell" - waitForIndex (testDataDir filepath) + waitForIndex filepath items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr -> do p <- openDoc fp "haskell" waitForKickDone @@ -479,10 +480,10 @@ closeDoc doc oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem -> Assertion) -> Assertion -oneCaseWithCreate contents queryX queryY expected = withCanonicalTempDir $ \dir -> - runSessionWithServer def plugin dir $ do +oneCaseWithCreate contents queryX queryY expected = + runCallHierarchySessionEmpty $ do doc <- createDoc "A.hs" "haskell" contents - waitForIndex (dir "A.hs") + waitForIndex "A.hs" item <- expectOneElement =<< Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc queryX queryY) liftIO $ expected (doc ^. L.uri) item closeDoc doc @@ -549,3 +550,23 @@ | isRelative fp1 = any (equalFilePath fp1 . joinPath) $ tails $ splitDirectories fp2 | otherwise = equalFilePath fp1 fp2 +runCallHierarchySession :: Session a -> IO a +runCallHierarchySession = + runSessionWithServerInTmpDir def plugin + (FS.mkVirtualFileTree + testDataDir + [ FS.copy "A.hs" + , FS.copy "B.hs" + , FS.copy "C.hs" + , FS.copy "hie.yaml" + ] + ) + +runCallHierarchySessionEmpty :: Session a -> IO a +runCallHierarchySessionEmpty = + runSessionWithServerInTmpDir def plugin + (FS.mkVirtualFileTree + testDataDir + [ + ] + ) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -6,7 +6,6 @@ import Control.Monad.Trans.Maybe import Data.Either.Extra (eitherToMaybe) -import Data.Functor.Identity (Identity) import qualified Data.Text as T import Development.IDE.GHC.Compat import GHC.Parser.Annotation @@ -20,11 +19,15 @@ import Control.Lens (_head, over) #endif +#if !MIN_VERSION_ghc_exactprint(1,10,0) +import Data.Functor.Identity (Identity) +#endif + makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) makeEditText pm df AddMinimalMethodsParams{..} = do mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup let ps = -#if !MIN_VERSION_ghc(9,9,0) +#if !MIN_VERSION_ghc(9,10,0) || MIN_VERSION_ghc(9,11,0) makeDeltaAst $ #endif pm_parsed_source pm diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -66,6 +66,12 @@ getActionByTitle "Add placeholders for 'g','h'" , goldenWithClass "Creates a placeholder when all top-level decls are indented" "T7" "" $ getActionByTitle "Add placeholders for 'g','h','i'" + , testGroup "with preprocessors" + [ knownBrokenInEnv [GhcVer GHC910] + "See issue https://github.com/haskell/haskell-language-server/issues/4731 for details." $ + goldenWithClass "Creates a placeholder for '<>'" "T8" "diamond" $ + getActionByTitle "Add placeholders for '<>'" + ] , goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ diff --git a/plugins/hls-class-plugin/test/testdata/T8.diamond.expected.hs b/plugins/hls-class-plugin/test/testdata/T8.diamond.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-class-plugin/test/testdata/T8.diamond.expected.hs @@ -0,0 +1,6 @@ +data Set a = Set + +instance Semigroup (Set a) where + (<>) = _ + +instance Monoid (Set a) where diff --git a/plugins/hls-class-plugin/test/testdata/T8.hs b/plugins/hls-class-plugin/test/testdata/T8.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-class-plugin/test/testdata/T8.hs @@ -0,0 +1,5 @@ +data Set a = Set + +instance Semigroup (Set a) where + +instance Monoid (Set a) where diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -90,7 +90,6 @@ #if MIN_VERSION_ghc(9,13,0) import GHC.Types.Avail (DetOrdAvails (DefinitelyDeterministicAvails), sortAvails) -import GHC.Tc.Types (tcg_exports) import GHC.Types.Name.Set (nameSetElemsStable) #endif import Ide.Logger (Priority (..), diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : PackageInfo_info_util -Description : Contents of some of the package's Cabal file's fields. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports values that record information from some of the fields of -the package's Cabal package description file (Cabal file). - -For further information about the fields in a Cabal file, see the Cabal User -Guide. --} - -module PackageInfo_info_util ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - --- |The content of the @name@ field of the package's Cabal file, but with any --- hyphen characters replaced by underscore characters. -name :: String -name = "info_util" --- |The content of the @version@ field of the package's Cabal file. -version :: Version -version = Version [0,1,0,0] [] - --- |The content of the @synopsis@ field of the package's Cabal file. -synopsis :: String -synopsis = "" --- |The content of the @copyright@ field of the package's Cabal file. -copyright :: String -copyright = "2017 Author name here" --- |The content of the @homepage@ field of the package's Cabal file. -homepage :: String -homepage = "" diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/Paths_info_util.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/Paths_info_util.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/info-util-0.1.0.0/build/autogen/Paths_info_util.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : Paths_info_util -Description : Data file location, and package version and installation - directories. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports a function to locate data files, and values that record -the version of the package and some directories which the package has been -configured to be installed into. - -For further information about Cabal's options for its configuration step, and -their default values, see the Cabal User Guide. --} - -module Paths_info_util ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - --- |The package version. -version :: Version -version = Version [0,1,0,0] [] - --- |If the argument is a filename, the result is the name of a corresponding --- file on the system on which the program is running, if the file were listed --- in the @data-files@ field of the package's Cabal package description file. --- No check is performed that the given filename is listed in that field. -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - --- |The location of the directory specified by Cabal's @--bindir@ option (where --- executables that the user might invoke are installed). This can be overridden --- at runtime using the environment variable info_util_bindir. -getBinDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libdir@ option (where --- object libraries are installed). This can be overridden at runtime using the --- environment variable info_util_libdir. -getLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--dynlibdir@ option --- (where dynamic libraries are installed). This can be overridden at runtime --- using the environment variable info_util_dynlibdir. -getDynLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--datadir@ option (where --- architecture-independent data files are installed). This can be overridden at --- runtime using the environment variable info_util_datadir. -getDataDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libexedir@ option --- (where executables that are not expected to be invoked directly by the user --- are installed). This can be overridden at runtime using the environment --- variable info_util_libexedir. -getLibexecDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--sysconfdir@ option --- (where configuration files are installed). This can be overridden at runtime --- using the environment variable info_util_sysconfdir. -getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c/info-util-0.1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.3-415c/info-util-0.1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.3-415c/info-util-0.1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "info_util_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "info_util_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "info_util_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "info_util_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "info_util_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "info_util_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir@(c:cs) fname - | isPathSeparator (lastChar c cs) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - where - -- We do not use Data.List.NonEmpty.last, as that would limit the module to - -- base >= 4.9.0.0 (GHC >= 8.0.1). - lastChar x [] = x - lastChar _ (x:xs) = lastChar x xs - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/PackageInfo_test.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/PackageInfo_test.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/PackageInfo_test.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : PackageInfo_test -Description : Contents of some of the package's Cabal file's fields. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports values that record information from some of the fields of -the package's Cabal package description file (Cabal file). - -For further information about the fields in a Cabal file, see the Cabal User -Guide. --} - -module PackageInfo_test ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - --- |The content of the @name@ field of the package's Cabal file, but with any --- hyphen characters replaced by underscore characters. -name :: String -name = "test" --- |The content of the @version@ field of the package's Cabal file. -version :: Version -version = Version [0,1,0,0] [] - --- |The content of the @synopsis@ field of the package's Cabal file. -synopsis :: String -synopsis = "" --- |The content of the @copyright@ field of the package's Cabal file. -copyright :: String -copyright = "2017 Author name here" --- |The content of the @homepage@ field of the package's Cabal file. -homepage :: String -homepage = "" diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/Paths_test.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/Paths_test.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.10.3/test-0.1.0.0/build/autogen/Paths_test.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : Paths_test -Description : Data file location, and package version and installation - directories. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports a function to locate data files, and values that record -the version of the package and some directories which the package has been -configured to be installed into. - -For further information about Cabal's options for its configuration step, and -their default values, see the Cabal User Guide. --} - -module Paths_test ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - --- |The package version. -version :: Version -version = Version [0,1,0,0] [] - --- |If the argument is a filename, the result is the name of a corresponding --- file on the system on which the program is running, if the file were listed --- in the @data-files@ field of the package's Cabal package description file. --- No check is performed that the given filename is listed in that field. -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - --- |The location of the directory specified by Cabal's @--bindir@ option (where --- executables that the user might invoke are installed). This can be overridden --- at runtime using the environment variable test_bindir. -getBinDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libdir@ option (where --- object libraries are installed). This can be overridden at runtime using the --- environment variable test_libdir. -getLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--dynlibdir@ option --- (where dynamic libraries are installed). This can be overridden at runtime --- using the environment variable test_dynlibdir. -getDynLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--datadir@ option (where --- architecture-independent data files are installed). This can be overridden at --- runtime using the environment variable test_datadir. -getDataDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libexedir@ option --- (where executables that are not expected to be invoked directly by the user --- are installed). This can be overridden at runtime using the environment --- variable test_libexedir. -getLibexecDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--sysconfdir@ option --- (where configuration files are installed). This can be overridden at runtime --- using the environment variable test_sysconfdir. -getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c/test-0.1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.10.3-415c" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.10.3-415c/test-0.1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.10.3-415c/test-0.1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "test_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "test_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "test_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "test_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "test_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "test_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir@(c:cs) fname - | isPathSeparator (lastChar c cs) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - where - -- We do not use Data.List.NonEmpty.last, as that would limit the module to - -- base >= 4.9.0.0 (GHC >= 8.0.1). - lastChar x [] = x - lastChar _ (x:xs) = lastChar x xs - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/PackageInfo_info_util.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : PackageInfo_info_util -Description : Contents of some of the package's Cabal file's fields. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports values that record information from some of the fields of -the package's Cabal package description file (Cabal file). - -For further information about the fields in a Cabal file, see the Cabal User -Guide. --} - -module PackageInfo_info_util ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - --- |The content of the @name@ field of the package's Cabal file, but with any --- hyphen characters replaced by underscore characters. -name :: String -name = "info_util" --- |The content of the @version@ field of the package's Cabal file. -version :: Version -version = Version [0,1,0,0] [] - --- |The content of the @synopsis@ field of the package's Cabal file. -synopsis :: String -synopsis = "" --- |The content of the @copyright@ field of the package's Cabal file. -copyright :: String -copyright = "2017 Author name here" --- |The content of the @homepage@ field of the package's Cabal file. -homepage :: String -homepage = "" diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/Paths_info_util.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/Paths_info_util.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/info-util-0.1.0.0/build/autogen/Paths_info_util.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : Paths_info_util -Description : Data file location, and package version and installation - directories. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports a function to locate data files, and values that record -the version of the package and some directories which the package has been -configured to be installed into. - -For further information about Cabal's options for its configuration step, and -their default values, see the Cabal User Guide. --} - -module Paths_info_util ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - --- |The package version. -version :: Version -version = Version [0,1,0,0] [] - --- |If the argument is a filename, the result is the name of a corresponding --- file on the system on which the program is running, if the file were listed --- in the @data-files@ field of the package's Cabal package description file. --- No check is performed that the given filename is listed in that field. -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - --- |The location of the directory specified by Cabal's @--bindir@ option (where --- executables that the user might invoke are installed). This can be overridden --- at runtime using the environment variable info_util_bindir. -getBinDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libdir@ option (where --- object libraries are installed). This can be overridden at runtime using the --- environment variable info_util_libdir. -getLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--dynlibdir@ option --- (where dynamic libraries are installed). This can be overridden at runtime --- using the environment variable info_util_dynlibdir. -getDynLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--datadir@ option (where --- architecture-independent data files are installed). This can be overridden at --- runtime using the environment variable info_util_datadir. -getDataDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libexedir@ option --- (where executables that are not expected to be invoked directly by the user --- are installed). This can be overridden at runtime using the environment --- variable info_util_libexedir. -getLibexecDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--sysconfdir@ option --- (where configuration files are installed). This can be overridden at runtime --- using the environment variable info_util_sysconfdir. -getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7/info-util-0.1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.14.1-ade7/info-util-0.1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.14.1-ade7/info-util-0.1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "info_util_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "info_util_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "info_util_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "info_util_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "info_util_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "info_util_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir@(c:cs) fname - | isPathSeparator (lastChar c cs) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - where - -- We do not use Data.List.NonEmpty.last, as that would limit the module to - -- base >= 4.9.0.0 (GHC >= 8.0.1). - lastChar x [] = x - lastChar _ (x:xs) = lastChar x xs - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/PackageInfo_test.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/PackageInfo_test.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/PackageInfo_test.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE NoRebindableSyntax #-} -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : PackageInfo_test -Description : Contents of some of the package's Cabal file's fields. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports values that record information from some of the fields of -the package's Cabal package description file (Cabal file). - -For further information about the fields in a Cabal file, see the Cabal User -Guide. --} - -module PackageInfo_test ( - name, - version, - synopsis, - copyright, - homepage, - ) where - -import Data.Version (Version(..)) -import Prelude - --- |The content of the @name@ field of the package's Cabal file, but with any --- hyphen characters replaced by underscore characters. -name :: String -name = "test" --- |The content of the @version@ field of the package's Cabal file. -version :: Version -version = Version [0,1,0,0] [] - --- |The content of the @synopsis@ field of the package's Cabal file. -synopsis :: String -synopsis = "" --- |The content of the @copyright@ field of the package's Cabal file. -copyright :: String -copyright = "2017 Author name here" --- |The content of the @homepage@ field of the package's Cabal file. -homepage :: String -homepage = "" diff --git a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/Paths_test.hs b/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/Paths_test.hs deleted file mode 100644 --- a/plugins/hls-eval-plugin/test/dist-newstyle/build/x86_64-linux/ghc-9.14.1/test-0.1.0.0/build/autogen/Paths_test.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NoRebindableSyntax #-} -#if __GLASGOW_HASKELL__ >= 810 -{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-} -#endif -{-# OPTIONS_GHC -Wno-missing-import-lists #-} -{-# OPTIONS_GHC -w #-} - -{-| -Module : Paths_test -Description : Data file location, and package version and installation - directories. - -WARNING: This module was generated by Cabal. Any modifications will be -overwritten if the module is regenerated. - -This module exports a function to locate data files, and values that record -the version of the package and some directories which the package has been -configured to be installed into. - -For further information about Cabal's options for its configuration step, and -their default values, see the Cabal User Guide. --} - -module Paths_test ( - version, - getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, - getDataFileName, getSysconfDir - ) where - - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -import Prelude - - -#if defined(VERSION_base) - -#if MIN_VERSION_base(4,0,0) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#else -catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a -#endif - -#else -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#endif -catchIO = Exception.catch - --- |The package version. -version :: Version -version = Version [0,1,0,0] [] - --- |If the argument is a filename, the result is the name of a corresponding --- file on the system on which the program is running, if the file were listed --- in the @data-files@ field of the package's Cabal package description file. --- No check is performed that the given filename is listed in that field. -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir `joinFileName` name) - --- |The location of the directory specified by Cabal's @--bindir@ option (where --- executables that the user might invoke are installed). This can be overridden --- at runtime using the environment variable test_bindir. -getBinDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libdir@ option (where --- object libraries are installed). This can be overridden at runtime using the --- environment variable test_libdir. -getLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--dynlibdir@ option --- (where dynamic libraries are installed). This can be overridden at runtime --- using the environment variable test_dynlibdir. -getDynLibDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--datadir@ option (where --- architecture-independent data files are installed). This can be overridden at --- runtime using the environment variable test_datadir. -getDataDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--libexedir@ option --- (where executables that are not expected to be invoked directly by the user --- are installed). This can be overridden at runtime using the environment --- variable test_libexedir. -getLibexecDir :: IO FilePath - --- |The location of the directory specified by Cabal's @--sysconfdir@ option --- (where configuration files are installed). This can be overridden at runtime --- using the environment variable test_sysconfdir. -getSysconfDir :: IO FilePath - - - - -bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath -bindir = "/home/hugin/.cabal/bin" -libdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7/test-0.1.0.0-inplace" -dynlibdir = "/home/hugin/.cabal/lib/x86_64-linux-ghc-9.14.1-ade7" -datadir = "/home/hugin/.cabal/share/x86_64-linux-ghc-9.14.1-ade7/test-0.1.0.0" -libexecdir = "/home/hugin/.cabal/libexec/x86_64-linux-ghc-9.14.1-ade7/test-0.1.0.0" -sysconfdir = "/home/hugin/.cabal/etc" - -getBinDir = catchIO (getEnv "test_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "test_libdir") (\_ -> return libdir) -getDynLibDir = catchIO (getEnv "test_dynlibdir") (\_ -> return dynlibdir) -getDataDir = catchIO (getEnv "test_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "test_libexecdir") (\_ -> return libexecdir) -getSysconfDir = catchIO (getEnv "test_sysconfdir") (\_ -> return sysconfdir) - - - -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir@(c:cs) fname - | isPathSeparator (lastChar c cs) = dir ++ fname - | otherwise = dir ++ pathSeparator : fname - where - -- We do not use Data.List.NonEmpty.last, as that would limit the module to - -- base >= 4.9.0.0 (GHC >= 8.0.1). - lastChar x [] = x - lastChar _ (x:xs) = lastChar x xs - -pathSeparator :: Char -pathSeparator = '/' - -isPathSeparator :: Char -> Bool -isPathSeparator c = c == '/' diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -19,10 +19,12 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe import Data.Aeson (ToJSON (toJSON)) +import Data.Function (on) import Data.Generics (GenericQ, everything, everythingBut, extQ, mkQ) import qualified Data.IntMap.Strict as IntMap -import Data.List (find, intersperse) +import Data.List (find, intersperse, + sortOn) import qualified Data.Map as Map import Data.Maybe (fromMaybe, isJust, mapMaybe, maybeToList) @@ -54,19 +56,22 @@ GenLocated (L), GhcPass, GhcTc, HasSrcSpan (getLoc), + HsBindLR (..), HsConDetails (RecCon), HsExpr (HsApp, HsVar, XExpr), HsFieldBind (hfbLHS), HsRecFields (..), - HsWrap (HsWrap), LPat, - Located, + HsWrap (HsWrap), LHsBind, + LPat, Located, + MatchGroup (..), + MatchGroupTc (..), NamedThing (getName), Outputable, TcGblEnv (tcg_binds), Var (varName), XXExprGhcTc (..), conLikeFieldLabels, - nameSrcSpan, + isGenerated, nameSrcSpan, pprNameUnqualified, recDotDot, unLoc) import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns), @@ -99,6 +104,7 @@ import Ide.Plugin.RangeMap (RangeMap) import qualified Ide.Plugin.RangeMap as RangeMap import Ide.Plugin.Resolve (mkCodeActionWithResolveAndCommand) +import Ide.PluginUtils (subRange) import Ide.Types (PluginDescriptor (..), PluginId (..), PluginMethodHandler, @@ -149,25 +155,45 @@ , pluginRules = collectRecordsRule recorder *> collectNamesRule } +data RecordConversionType + = RecordWildcardExpansion + | RecordTraditionalSyntaxConversion + +data RecordConversion = + RecordConversion + Int -- ^ uid + RecordConversionType + +-- | Given a record, determine whether it is a case of wildcard expansion +-- or a conversion to the traditional record syntax. +getConversionType :: RecordInfo -> Maybe RecordConversionType +getConversionType = \case + -- Only fully saturated constructor applications can be converted to + -- the record syntax through the code action + RecordInfoApp _ (RecordAppExpr Unsaturated _ _) -> Nothing + RecordInfoApp {} -> Just RecordTraditionalSyntaxConversion + _ -> Just RecordWildcardExpansion + codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do nfp <- getNormalizedFilePathE (docId ^. L.uri) CRR {crCodeActions, crCodeActionResolve, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp -- All we need to build a code action is the list of extensions, and a int to -- allow us to resolve it later. - let recordUids = [ uid + let recordsWithUid = [ (RecordConversion uid conversionType, record) | uid <- RangeMap.filterByRange range crCodeActions , Just record <- [IntMap.lookup uid crCodeActionResolve] - -- Only fully saturated constructor applications can be - -- converted to the record syntax through the code action - , isConvertible record + , Just conversionType <- [getConversionType record] ] - let actions = map (mkCodeAction enabledExtensions) recordUids - pure $ InL actions + recordsOnly = map snd recordsWithUid + sortedRecords = sortOn (recordDepth recordsOnly . snd) recordsWithUid + pure $ InL $ case sortedRecords of + (top : _) -> [mkCodeAction enabledExtensions (fst top)] + [] -> [] where - mkCodeAction :: [Extension] -> Int -> Command |? CodeAction - mkCodeAction exts uid = InR CodeAction - { _title = mkTitle exts -- TODO: `Expand positional record` without NamedFieldPuns if RecordInfoApp + mkCodeAction :: [Extension] -> RecordConversion -> Command |? CodeAction + mkCodeAction exts (RecordConversion uid conversionType) = InR CodeAction + { _title = mkTitle exts conversionType , _kind = Just CodeActionKind_RefactorRewrite , _diagnostics = Nothing , _isPreferred = Nothing @@ -177,11 +203,6 @@ , _data_ = Just $ toJSON uid } - isConvertible :: RecordInfo -> Bool - isConvertible = \case - RecordInfoApp _ (RecordAppExpr Unsaturated _ _) -> False - _ -> True - codeActionResolveProvider :: ResolveFunction IdeState Int 'Method_CodeActionResolve codeActionResolveProvider ideState pId ca uri uid = do nfp <- getNormalizedFilePathE uri @@ -246,7 +267,7 @@ , _label = InR label , _kind = Nothing -- neither a type nor a parameter , _textEdits = Just textEdits -- same as CodeAction - , _tooltip = Just $ InL (mkTitle enabledExtensions) -- same as CodeAction + , _tooltip = Just $ InL (mkTitle enabledExtensions RecordWildcardExpansion) -- same as CodeAction , _paddingLeft = Just True -- padding after dotdot , _paddingRight = Nothing , _data_ = Nothing @@ -266,9 +287,12 @@ pure $ InL (concatMap (mkInlayHints nameMap pm) records) where mkInlayHints :: UniqFM Name [Name] -> PositionMapping -> RecordInfo -> [InlayHint] - mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr _ _ fla)) = - let textEdits = renderRecordInfoAsTextEdit nameMap record - in mapMaybe (mkInlayHint textEdits pm) fla + mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr sat _ fla)) = + -- Only create inlay hints for fully saturated constructors + case sat of + Saturated -> let textEdits = renderRecordInfoAsTextEdit nameMap record + in mapMaybe (mkInlayHint textEdits pm) fla + Unsaturated -> [] mkInlayHints _ _ _ = [] mkInlayHint :: Maybe TextEdit -> PositionMapping -> (Located FieldLabel, HsExpr GhcTc) -> Maybe InlayHint @@ -282,7 +306,7 @@ , _label = InR $ pure (mkInlayHintLabelPart name fieldDefLoc) , _kind = Nothing -- neither a type nor a parameter , _textEdits = Just (maybeToList te) -- same as CodeAction - , _tooltip = Just $ InL "Expand positional record" -- same as CodeAction + , _tooltip = Just $ InL (mkTitle [] RecordTraditionalSyntaxConversion) -- same as CodeAction , _paddingLeft = Nothing , _paddingRight = Nothing , _data_ = Nothing @@ -290,12 +314,22 @@ mkInlayHintLabelPart name loc = InlayHintLabelPart (printFieldName (pprNameUnqualified name) <> "=") Nothing loc Nothing -mkTitle :: [Extension] -> Text -mkTitle exts = "Expand record wildcard" - <> if NamedFieldPuns `elem` exts - then mempty - else " (needs extension: NamedFieldPuns)" +mkTitle :: [Extension] -> RecordConversionType -> Text +mkTitle exts = \case + RecordWildcardExpansion -> + "Expand record wildcard" + <> if NamedFieldPuns `elem` exts + then mempty + else " (needs extension: NamedFieldPuns)" + RecordTraditionalSyntaxConversion -> + "Convert to traditional record syntax" +-- Calculate the nesting depth of a record by counting how many other records +-- contain it. Used to prioritize more deeply nested records in code actions. +recordDepth :: [RecordInfo] -> RecordInfo -> Int +recordDepth allRecords record = + let isSubrangeOf = subRange `on` recordInfoToRange + in length $ filter (`isSubrangeOf` record) allRecords pragmaEdit :: [Extension] -> NextPragmaInfo -> Maybe TextEdit pragmaEdit exts pragma = if NamedFieldPuns `elem` exts @@ -565,8 +599,16 @@ where showFieldWithArg (field, arg) = printFieldName field <> " = " <> printOutputable arg collectRecords :: GenericQ [RecordInfo] -collectRecords = everythingBut (<>) (([], False) `mkQ` getRecPatterns `extQ` getRecCons) +collectRecords = everythingBut (<>) (([], False) `mkQ` ignoreGenerated `extQ` getRecPatterns `extQ` getRecCons) +-- | Prevent the SYB traversal to descend further if the matching group +-- in question is compiler-generated (e.g. TH, deriving). Doing so is necessary +-- in order to not create inlay hints for TH-generated records. +ignoreGenerated :: LHsBind GhcTc -> ([RecordInfo], Bool) +ignoreGenerated (unLoc -> FunBind _ _ (MG (MatchGroupTc _ _ origin) _)) + | isGenerated origin = ([], True) +ignoreGenerated _ = ([], False) + -- | Collect 'Name's into a map, indexed by the names' unique identifiers. -- The 'Eq' instance of 'Name's makes use of their unique identifiers, hence -- any 'Name' referring to the same entity is considered equal. In effect, @@ -602,7 +644,11 @@ getRecCons expr@(unLoc -> app@(HsApp _ _ _)) = let fieldss = maybeToList $ getFields app [] recInfo = concatMap mkRecInfo fieldss - in (recInfo, not (null recInfo)) + -- Search control for positional constructors. + -- True stops further (nested) searching; False allows recursive search. + -- Currently hardcoded to False to enable nested positional searches. + -- Use `in (recInfo, not (null recInfo))` to disable nested searching. + in (recInfo, False) where mkRecInfo :: RecordAppExpr -> [RecordInfo] mkRecInfo appExpr = diff --git a/plugins/hls-explicit-record-fields-plugin/test/Main.hs b/plugins/hls-explicit-record-fields-plugin/test/Main.hs --- a/plugins/hls-explicit-record-fields-plugin/test/Main.hs +++ b/plugins/hls-explicit-record-fields-plugin/test/Main.hs @@ -22,22 +22,24 @@ test :: TestTree test = testGroup "explicit-fields" [ testGroup "code actions" - [ mkTest "WildcardOnly" "WildcardOnly" 12 10 12 20 - , mkTest "Unused" "Unused" 12 10 12 20 - , mkTest "Unused2" "Unused2" 12 10 12 20 - , mkTest "WithPun" "WithPun" 13 10 13 25 - , mkTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32 - , mkTest "Mixed" "Mixed" 14 10 14 37 - , mkTest "Construction" "Construction" 16 5 16 15 - , mkTest "PositionalConstruction" "PositionalConstruction" 15 5 15 15 - , mkTest "HsExpanded1" "HsExpanded1" 17 10 17 20 - , mkTest "HsExpanded2" "HsExpanded2" 23 10 23 22 + [ mkExpansionTest "WildcardOnly" "WildcardOnly" 12 10 12 20 + , mkExpansionTest "Unused" "Unused" 12 10 12 20 + , mkExpansionTest "Unused2" "Unused2" 12 10 12 20 + , mkExpansionTest "WithPun" "WithPun" 13 10 13 25 + , mkExpansionTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32 + , mkExpansionTest "Mixed" "Mixed" 14 10 14 37 + , mkExpansionTest "Construction" "Construction" 16 5 16 15 + , mkConversionTest "PositionalConstruction" "PositionalConstruction" 15 5 15 15 + , mkExpansionTest "HsExpanded1" "HsExpanded1" 17 10 17 20 + , mkExpansionTest "HsExpanded2" "HsExpanded2" 23 10 23 22 , mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52 , mkTestNoAction "Puns" "Puns" 12 10 12 31 , mkTestNoAction "Infix" "Infix" 11 11 11 31 , mkTestNoAction "Prefix" "Prefix" 10 11 10 28 , mkTestNoAction "PartiallyAppliedCon" "PartiallyAppliedCon" 7 8 7 12 - , mkTest "PolymorphicRecordConstruction" "PolymorphicRecordConstruction" 15 5 15 15 + , mkConversionTest "PolymorphicRecordConstruction" "PolymorphicRecordConstruction" 15 5 15 15 + , mkConversionTest "CursorAwarePositional" "CursorPositional" 15 26 15 34 + , mkExpansionTest "CursorAwareRecords" "CursorRecords" 9 40 9 40 ] , testGroup "inlay hints" [ mkInlayHintsTest "Construction" Nothing 16 $ \ih -> do @@ -84,19 +86,19 @@ [ defInlayHint { _position = Position 15 11 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 13 , _label = InR [ bar ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 15 , _label = InR [ baz ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } ] @@ -109,19 +111,19 @@ [ defInlayHint { _position = Position 15 11 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 13 , _label = InR [ bar ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 15 , _label = InR [ baz ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } ] @@ -142,7 +144,7 @@ [defInlayHint { _position = Position 13 21 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 13 15 22 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing }] , mkInlayHintsTest "HsExpanded1DuplicateRecordFields" (Just " (positional)") 13 $ \ih -> do @@ -152,7 +154,7 @@ [defInlayHint { _position = Position 13 21 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 13 15 22 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing }] , mkInlayHintsTest "HsExpanded2" Nothing 23 $ \ih -> do @@ -172,7 +174,7 @@ [defInlayHint { _position = Position 16 21 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 16 15 22 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing }] , mkInlayHintsTest "Mixed" Nothing 14 $ \ih -> do @@ -276,25 +278,112 @@ [ defInlayHint { _position = Position 15 11 , _label = InR [ foo ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 13 , _label = InR [ bar ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } , defInlayHint { _position = Position 15 15 , _label = InR [ baz ] , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ] - , _tooltip = Just $ InL "Expand positional record" + , _tooltip = Just $ InL "Convert to traditional record syntax" , _paddingLeft = Nothing } ] + , mkInlayHintsTest "CursorRecords" Nothing 9 $ \ih -> do + let mkLabelPart' = mkLabelPartOffsetLength "CursorRecords" + a0 <- mkLabelPart' 3 14 "a0" + a1 <- mkLabelPart' 4 14 "a1" + a11 <- mkLabelPart' 4 25 "a11" + a2 <- mkLabelPart' 5 14 "a2" + a3 <- mkLabelPart' 6 14 "a3" + (@?=) ih + [ defInlayHint + { _position = Position 9 52 + , _label = InR [ a3 ] + , _textEdits = Just [ mkLineTextEdit "L1 {l2 = L2 {l3 = L3 {l4 = L4 {..}, ..}, ..}, a3}" 9 5 53 ] + , _tooltip = Just $ InL "Expand record wildcard" + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + , defInlayHint + { _position = Position 9 47 + , _label = InR [ a2 ] + , _textEdits = Just [ mkLineTextEdit "L2 {l3 = L3 {l4 = L4 {..}, ..}, a2}" 9 14 48 ] + , _tooltip = Just $ InL "Expand record wildcard" + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + , defInlayHint + { _position = Position 9 42 + , _label = InR [ a1 , InlayHintLabelPart ", " Nothing Nothing Nothing , a11 ] + , _textEdits = Just [ mkLineTextEdit "L3 {l4 = L4 {..}, a1, a11}" 9 23 43 ] + , _tooltip = Just $ InL "Expand record wildcard" + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + , defInlayHint + { _position = Position 9 37 + , _label = InR [ a0 ] + , _textEdits = Just [ mkLineTextEdit "L4 {a0}" 9 31 38 ] + , _tooltip = Just $ InL "Expand record wildcard" + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + ] + , mkInlayHintsTest "CursorPositional" Nothing 15 $ \ih -> do + let mkLabelPart' = mkLabelPartOffsetLengthSub1 "CursorPositional" + middle <- mkLabelPart' 2 2 "middle=" + inner <- mkLabelPart' 6 2 "inner=" + foo <- mkLabelPart' 10 2 "foo=" + bar <- mkLabelPart' 11 4 "bar=" + (@?=) ih + [ defInlayHint + { _position = Position 15 14 + , _label = InR [ middle ] + , _textEdits = Just [ mkLineTextEdit "RecOuter { middle = (RecMiddle (RecInner 'c' 42)) }" 15 5 43 ] + , _tooltip = Just $ InL "Convert to traditional record syntax" + , _paddingLeft = Nothing + } + , defInlayHint + { _position = Position 15 25 + , _label = InR [ inner ] + , _textEdits = Just [ mkLineTextEdit "RecMiddle { inner = (RecInner 'c' 42) }" 15 15 42 ] + , _tooltip = Just $ InL "Convert to traditional record syntax" + , _paddingLeft = Nothing + } + , defInlayHint + { _position = Position 15 35 + , _label = InR [ foo ] + , _textEdits = + Just [ mkLineTextEdit "RecInner { foo = 'c', bar = 42 }" 15 26 41 ] + , _tooltip = Just $ InL "Convert to traditional record syntax" + , _paddingLeft = Nothing + } + , defInlayHint + { _position = Position 15 39 + , _label = InR [ bar ] + , _textEdits = + Just [ mkLineTextEdit "RecInner { foo = 'c', bar = 42 }" 15 26 41 ] + , _tooltip = Just $ InL "Convert to traditional record syntax" + , _paddingLeft = Nothing + } + ] + , mkInlayHintsTest "InlayHintTH" Nothing 6 $ assertNoInlayHints ] ] +assertNoInlayHints :: [InlayHint] -> Assertion +assertNoInlayHints = assertBool "There exists an inlay hint whereas there should have been none" . null + mkInlayHintsTest :: FilePath -> Maybe TestName -> UInt -> ([InlayHint] -> Assertion) -> TestTree mkInlayHintsTest fp postfix line assert = testCase (fp ++ concat postfix) $ @@ -310,34 +399,46 @@ testCase title $ runSessionWithServer def plugin (testDataDir "noop") $ do doc <- openDoc (fp <.> "hs") "haskell" - actions <- getExplicitFieldsActions doc x1 y1 x2 y2 + actions <- getActions isExplicitFieldsCodeAction doc x1 y1 x2 y2 liftIO $ actions @?= [] -mkTestWithCount :: Int -> TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree -mkTestWithCount cnt title fp x1 y1 x2 y2 = +mkTestWithCountAndMessage :: (CodeAction -> Bool) -> Int -> TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree +mkTestWithCountAndMessage msgPredicate cnt title fp x1 y1 x2 y2 = goldenWithHaskellAndCaps def codeActionResolveCaps plugin title testDataDir fp "expected" "hs" $ \doc -> do - acts@(act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2 + acts@(act:_) <- getActions msgPredicate doc x1 y1 x2 y2 liftIO $ length acts @?= cnt executeCodeAction act -mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree -mkTest = mkTestWithCount 1 +mkExpansionTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree +mkExpansionTest = mkTestWithCountAndMessage isRecWildcardExpansionCodeAction 1 -getExplicitFieldsActions - :: TextDocumentIdentifier +mkConversionTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree +mkConversionTest = mkTestWithCountAndMessage isRecLiteralConversionCodeAction 1 + +getActions + :: (CodeAction -> Bool) -> TextDocumentIdentifier -> UInt -> UInt -> UInt -> UInt -> Session [CodeAction] -getExplicitFieldsActions doc x1 y1 x2 y2 = - findExplicitFieldsAction <$> getAndResolveCodeActions doc range +getActions p doc x1 y1 x2 y2 = + findAction p <$> getAndResolveCodeActions doc range where range = Range (Position x1 y1) (Position x2 y2) -findExplicitFieldsAction :: [a |? CodeAction] -> [CodeAction] -findExplicitFieldsAction = filter isExplicitFieldsCodeAction . rights . map toEither +findAction :: (CodeAction -> Bool) -> [a |? CodeAction] -> [CodeAction] +findAction p = filter p . rights . map toEither isExplicitFieldsCodeAction :: CodeAction -> Bool -isExplicitFieldsCodeAction CodeAction {_title} = +isExplicitFieldsCodeAction act = + isRecWildcardExpansionCodeAction act + || isRecLiteralConversionCodeAction act + +isRecWildcardExpansionCodeAction :: CodeAction -> Bool +isRecWildcardExpansionCodeAction CodeAction {_title} = "Expand record wildcard" `T.isPrefixOf` _title + +isRecLiteralConversionCodeAction :: CodeAction -> Bool +isRecLiteralConversionCodeAction CodeAction {_title} = + "Convert to traditional record syntax" `T.isPrefixOf` _title defInlayHint :: InlayHint defInlayHint = diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.expected.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.expected.hs @@ -0,0 +1,16 @@ +module CursorPositional where +data RecOuter = RecOuter{ + middle :: RecMiddle +} + +data RecMiddle = RecMiddle { + inner :: RecInner +} + +data RecInner = RecInner{ + foo :: Char + , bar :: Int +} + +ex :: RecOuter +ex = RecOuter (RecMiddle (RecInner { foo = 'c', bar = 42 })) diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.hs @@ -0,0 +1,16 @@ +module CursorPositional where +data RecOuter = RecOuter{ + middle :: RecMiddle +} + +data RecMiddle = RecMiddle { + inner :: RecInner +} + +data RecInner = RecInner{ + foo :: Char + , bar :: Int +} + +ex :: RecOuter +ex = RecOuter (RecMiddle (RecInner 'c' 42)) diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.expected.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RecordWildCards #-} +module CursorRecords where + +data L4 = L4{ a0 :: Int} +data L3 = L3{ a1 :: Int, a11 :: Int, l4 :: L4} +data L2 = L2{ a2 :: Int, l3 :: L3} +data L1 = L1{ a3 :: Int, l2 :: L2} + +test :: L1 -> Int +test L1 {l2 = L2{ l3 = L3 {l4 = L4 {..}, a1, a11}, ..}, ..} = + a0 + a1 + a2 + a3 + a11 diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RecordWildCards #-} +module CursorRecords where + +data L4 = L4{ a0 :: Int} +data L3 = L3{ a1 :: Int, a11 :: Int, l4 :: L4} +data L2 = L2{ a2 :: Int, l3 :: L3} +data L1 = L1{ a3 :: Int, l2 :: L2} + +test :: L1 -> Int +test L1 {l2 = L2{ l3 = L3{l4 = L4 {..}, ..}, ..}, ..} = + a0 + a1 + a2 + a3 + a11 diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/InlayHintTH.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/InlayHintTH.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/InlayHintTH.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module InlayHintTH where + +import TH (mkVal) + +$(mkVal) diff --git a/plugins/hls-explicit-record-fields-plugin/test/testdata/TH.hs b/plugins/hls-explicit-record-fields-plugin/test/testdata/TH.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-explicit-record-fields-plugin/test/testdata/TH.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} + +module TH where + +import Language.Haskell.TH + +data MyRec + = MyRec + { foo :: Char + , bar :: Int + } + +mkVal :: Q [Dec] +mkVal = do + x <- newName "x" + pure $ + [ ValD + (VarP x) + ( NormalB + ( AppE + (AppE (ConE 'MyRec) (LitE (CharL 'c'))) + (LitE (IntegerL 42)) + ) + ) + [] + ] diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs deleted file mode 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -module Ide.Plugin.Floskell - ( descriptor - , provider - ) where - -import Control.Monad.Except (throwError) -import Control.Monad.IO.Class -import Data.List (find) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Development.IDE hiding (pluginHandlers) -import Development.IDE.Core.PluginUtils (mkFormattingHandlers) -import Floskell -import Ide.Plugin.Error -import Ide.PluginUtils -import Ide.Types -import Language.LSP.Protocol.Types - --- --------------------------------------------------------------------- - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId desc) - { pluginHandlers = mkFormattingHandlers provider - } - where - desc = "Provides formatting of Haskell files via floskell. Built with floskell-" <> VERSION_floskell - --- --------------------------------------------------------------------- - --- | Format provider of Floskell. --- Formats the given source in either a given Range or the whole Document. --- If the provider fails an error is returned that can be displayed to the user. -provider :: FormattingHandler IdeState -provider _ideState _token typ contents fp _ = do - let file = fromNormalizedFilePath fp - config <- liftIO $ findConfigOrDefault file - let (range, selectedContents) = case typ of - FormatText -> (fullRange contents, contents) - FormatRange r -> (normalize r, extractTextInRange (extendToFullLines r) contents) - result = reformat config (Just file) $ TL.fromStrict selectedContents - case result of - Left err -> throwError $ PluginInternalError $ T.pack $ "floskellCmd: " ++ err - Right new -> pure $ InL [TextEdit range $ TL.toStrict new] - --- | Find Floskell Config, user and system wide or provides a default style. --- Every directory of the filepath will be searched to find a user configuration. --- Also looks into places such as XDG_CONFIG_DIRECTORY. --- This function may not throw an exception and returns a default config. -findConfigOrDefault :: FilePath -> IO AppConfig -findConfigOrDefault file = do - mbConf <- findAppConfigIn file - case mbConf of - Just confFile -> readAppConfig confFile - Nothing -> - pure $ case find (\s -> styleName s == "gibiansky") styles of - Just gibiansky -> defaultAppConfig { appStyle = gibiansky } - Nothing -> defaultAppConfig - --- --------------------------------------------------------------------- diff --git a/plugins/hls-floskell-plugin/test/Main.hs b/plugins/hls-floskell-plugin/test/Main.hs deleted file mode 100644 --- a/plugins/hls-floskell-plugin/test/Main.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main - ( main - ) where - -import qualified Ide.Plugin.Floskell as Floskell -import System.FilePath -import Test.Hls - -main :: IO () -main = defaultTestRunner tests - -floskellPlugin :: PluginTestDescriptor () -floskellPlugin = mkPluginTestDescriptor' Floskell.descriptor "floskell" - -tests :: TestTree -tests = testGroup "floskell" - [ goldenWithFloskell "formats a document" "Floskell" "formatted_document" $ \doc -> do - formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) - - , goldenWithFloskell "formats a range" "Floskell" "formatted_range" $ \doc -> do - let range = Range (Position 1 0) (Position 4 22) - formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) range - ] - -goldenWithFloskell :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithFloskell title path desc = goldenWithHaskellDocFormatter def floskellPlugin "floskell" def title testDataDir path desc "hs" - -testDataDir :: FilePath -testDataDir = "plugins" "hls-floskell-plugin" "test" "testdata" diff --git a/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_document.hs b/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_document.hs deleted file mode 100644 --- a/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_document.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Floskell where - -import Data.List -import Prelude -import Data.Int - -foo :: Int -> Int -foo 3 = 2 -foo x = x - -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz { a :: Int, b :: String } - diff --git a/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_range.hs b/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_range.hs deleted file mode 100644 --- a/plugins/hls-floskell-plugin/test/testdata/Floskell.formatted_range.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Floskell where -import Data.List -import Prelude -import Data.Int -foo :: Int -> Int -foo 3 = 2 -foo x = x -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz { a :: Int, b :: String } - diff --git a/plugins/hls-floskell-plugin/test/testdata/Floskell.hs b/plugins/hls-floskell-plugin/test/testdata/Floskell.hs deleted file mode 100644 --- a/plugins/hls-floskell-plugin/test/testdata/Floskell.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Floskell where -import Data.List - -import Prelude -import Data.Int -foo :: Int -> Int -foo 3 = 2 -foo x = x -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz { a :: Int, b :: String } - diff --git a/plugins/hls-floskell-plugin/test/testdata/hie.yaml b/plugins/hls-floskell-plugin/test/testdata/hie.yaml deleted file mode 100644 --- a/plugins/hls-floskell-plugin/test/testdata/hie.yaml +++ /dev/null @@ -1,3 +0,0 @@ -cradle: - direct: - arguments: [] diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -145,7 +145,12 @@ pure $ InL $ makeDiffTextEdit contents out ExitFailure n -> do logWith recorder Info $ StdErr err - throwError $ PluginInternalError $ "Fourmolu failed with exit code " <> T.pack (show n) + let cleanErr = T.stripEnd err + let cliError = if T.null cleanErr + then "" + else "\n" <> cleanErr + throwError $ PluginInternalError $ + "Fourmolu failed with exit code " <> T.pack (show n) <> cliError loadConfig :: Recorder (WithPriority LogEvent) -> diff --git a/plugins/hls-fourmolu-plugin/test/Main.hs b/plugins/hls-fourmolu-plugin/test/Main.hs --- a/plugins/hls-fourmolu-plugin/test/Main.hs +++ b/plugins/hls-fourmolu-plugin/test/Main.hs @@ -3,11 +3,15 @@ ( main ) where +import Control.Lens ((^.)) import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Data.Functor +import qualified Data.Map as M +import qualified Data.Text as T import Ide.Plugin.Config import qualified Ide.Plugin.Fourmolu as Fourmolu +import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types import Language.LSP.Test import System.FilePath @@ -31,6 +35,28 @@ formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) , goldenWithFourmolu cli "uses correct operator fixities" "Fourmolu3" "formatted" $ \doc -> do formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + , testCase "error message contains stderr output" $ do + let cliConfig = def { + formattingProvider = "fourmolu", + plugins = M.fromList [("fourmolu", def { plcConfig = KM.fromList ["external" .= True] })] + } + runSessionWithServer cliConfig fourmoluPlugin testDataDir $ do + doc <- openDoc "FormatError.hs" "haskell" + void waitForBuildQueue + resp <- request SMethod_TextDocumentFormatting $ + DocumentFormattingParams Nothing doc (FormattingOptions 4 True Nothing Nothing Nothing) + liftIO $ case resp ^. L.result of + Left err -> do + let msg = err ^. L.message + -- Verify the error message structure: + -- 1. Contains the exit code prefix (base message intact) + assertBool ("Expected exit code prefix, got: " <> T.unpack msg) + ("failed with exit code" `T.isInfixOf` msg) + -- 2. Contains a stable parse-error phrase from formatter stderr + assertBool ("Expected parse error details from stderr, got: " <> T.unpack msg) + ("parse error on input" `T.isInfixOf` msg) + Right _ -> + assertFailure "Expected formatting to fail on unparsable file" ] goldenWithFourmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree diff --git a/plugins/hls-fourmolu-plugin/test/testdata/FormatError.hs b/plugins/hls-fourmolu-plugin/test/testdata/FormatError.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-fourmolu-plugin/test/testdata/FormatError.hs @@ -0,0 +1,3 @@ +module FormatError where + +foo = let x = 1 in in x diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -86,7 +86,7 @@ codeActionHandler state plId (CodeActionParams _ _ doc range _) = withExceptT handleGhcidePluginError $ do nfp <- withExceptT GhcidePluginErrors $ getNormalizedFilePathE (doc ^. L.uri) (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nfp - let actions = map (mkAction . printOutputable . tcdLName . unLoc) inRangeH98Decls + let actions = map (mkAction . printOutputable . tyClDeclLName . unLoc) inRangeH98Decls pure $ InL actions where mkAction :: T.Text -> Command |? CodeAction diff --git a/plugins/hls-hlint-plugin/test/Main.hs b/plugins/hls-hlint-plugin/test/Main.hs --- a/plugins/hls-hlint-plugin/test/Main.hs +++ b/plugins/hls-hlint-plugin/test/Main.hs @@ -218,8 +218,8 @@ doc <- openDoc "TwoHints.hs" "haskell" _ <- hlintCaptureKick - firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 0 0) - secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 1 0) + firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 1 0) + secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 2 0) thirdLine <- map fromAction <$> getCodeActions doc (mkRange 2 0 2 0) multiLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 2 0) diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ /dev/null @@ -1,196 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} - -{- | Keep the module name in sync with its file path. - -Provide CodeLenses to: -* Add a module header ("module /moduleName/ where") to empty Haskell files -* Fix the module name if incorrect --} -module Ide.Plugin.ModuleName ( - descriptor, - Log, -) where - -import Control.Monad (forM_, void) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except -import Control.Monad.Trans.Maybe -import Data.Aeson (toJSON) -import Data.Char (isLower, isUpper) -import Data.List (intercalate, minimumBy, - stripPrefix) -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map -import Data.Maybe (mapMaybe) -import Data.Ord (comparing) -import Data.String (IsString) -import qualified Data.Text as T -import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE (GetParsedModule (GetParsedModule), - GhcSession (GhcSession), - IdeState, Pretty, - Priority (Debug), - Recorder, WithPriority, - colon, evalGhcEnv, - hscEnv, logWith, - realSrcSpanToRange, - rootDir, runAction, - useWithStale, (<+>)) -import Development.IDE.Core.FileStore (getFileContents) -import Development.IDE.Core.PluginUtils -import Development.IDE.Core.PositionMapping (toCurrentRange) -import Development.IDE.GHC.Compat (GenLocated (L), - getSessionDynFlags, - hsmodName, importPaths, - locA, moduleNameString, - pattern RealSrcSpan, - pm_parsed_source, unLoc) -import Ide.Logger (Pretty (..)) -import Ide.Plugin.Error -import Ide.PluginUtils (toAbsolute) -import Ide.Types -import Language.LSP.Protocol.Message -import Language.LSP.Protocol.Types -import System.FilePath (dropExtension, normalise, - pathSeparator, - splitDirectories, - takeFileName) - --- |Plugin descriptor -descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = - (defaultPluginDescriptor plId "Provides a code action to alter the module name if it is wrong") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeLens (codeLens recorder) - , pluginCommands = [PluginCommand updateModuleNameCommand "set name of module to match with file path" (command recorder)] - } - -updateModuleNameCommand :: IsString p => p -updateModuleNameCommand = "updateModuleName" - --- | Generate code lenses -codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens -codeLens recorder state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do - res <- action recorder state uri - pure $ InL (asCodeLens <$> res) - where - asCodeLens :: Action -> CodeLens - asCodeLens Replace{..} = CodeLens aRange (Just cmd) Nothing - where - cmd = mkLspCommand pluginId updateModuleNameCommand aTitle (Just [toJSON aUri]) - --- | (Quasi) Idempotent command execution: recalculate action to execute on command request -command :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri -command recorder state _ uri = do - actMaybe <- action recorder state uri - forM_ actMaybe $ \Replace{..} -> - let - -- | Convert an Action to the corresponding edit operation - edit = WorkspaceEdit (Just $ Map.singleton aUri [TextEdit aRange aCode]) Nothing Nothing - in - void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (const (pure ())) - pure $ InR Null - --- | A source code change -data Action = Replace - { aUri :: Uri - , aRange :: Range - , aTitle :: T.Text - , aCode :: T.Text - } - deriving (Show) - --- | Required action (that can be converted to either CodeLenses or CodeActions) -action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action] -action recorder state uri = do - nfp <- getNormalizedFilePathE uri - fp <- uriToFilePathE uri - - contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nfp - let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents - - correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp - logWith recorder Debug (CorrectNames correctNames) - let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames - logWith recorder Debug (BestName bestName) - - statedNameMaybe <- liftIO $ codeModuleName state nfp - logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe) - case (bestName, statedNameMaybe) of - (Just bestName, Just (nameRange, statedName)) - | statedName `notElem` correctNames -> - pure [Replace uri nameRange ("Set module name to " <> bestName) bestName] - (Just bestName, Nothing) - | emptyModule -> - let code = "module " <> bestName <> " where\n" - in pure [Replace uri (Range (Position 0 0) (Position 0 0)) code code] - _ -> pure [] - --- | Possible module names, as derived by the position of the module in the --- source directories. There may be more than one possible name, if the source --- directories are nested inside each other. -pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text] -pathModuleNames recorder state normFilePath filePath - | firstLetter isLower $ takeFileName filePath = return ["Main"] - | otherwise = do - (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath - srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags - logWith recorder Debug (SrcPaths srcPaths) - - -- Append a `pathSeparator` to make the path looks like a directory, - -- and then we can drop it uniformly. - -- See https://github.com/haskell/haskell-language-server/pull/3092 for details. - let paths = map (normalise . (<> pure pathSeparator)) srcPaths - logWith recorder Debug (NormalisedPaths paths) - - -- TODO, this can be avoid if the filePath is already absolute, - -- we can avoid the toAbsolute call in the future. - -- see Note [Root Directory] - let mdlPath = (toAbsolute $ rootDir state) filePath - logWith recorder Debug (AbsoluteFilePath mdlPath) - - let suffixes = mapMaybe (`stripPrefix` mdlPath) paths - pure (map moduleNameFrom suffixes) - where - firstLetter :: (Char -> Bool) -> FilePath -> Bool - firstLetter _ [] = False - firstLetter pred (c:_) = pred c - - moduleNameFrom = - T.pack - . intercalate "." - -- Do not suggest names whose components start from a lower-case char, - -- they are guaranteed to be malformed. - . filter (firstLetter isUpper) - . splitDirectories - . dropExtension - --- | The module name, as stated in the module -codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) -codeModuleName state nfp = runMaybeT $ do - (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ useWithStale GetParsedModule nfp - L (locA -> (RealSrcSpan l _)) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm - range <- MaybeT . pure $ toCurrentRange mp (realSrcSpanToRange l) - pure (range, T.pack $ moduleNameString m) - -data Log = - CorrectNames [T.Text] - | BestName (Maybe T.Text) - | ModuleName (Maybe T.Text) - | SrcPaths [FilePath] - | NormalisedPaths [FilePath] - | AbsoluteFilePath FilePath - deriving Show - -instance Pretty Log where - pretty log = "ModuleName." <> case log of - CorrectNames log -> "CorrectNames" <> colon <+> pretty log - BestName log -> "BestName" <> colon <+> pretty log - ModuleName log -> "StatedNameMaybe" <> colon <+> pretty log - SrcPaths log -> "SrcPaths" <> colon <+> pretty log - NormalisedPaths log -> "NormalisedPaths" <> colon <+> pretty log - AbsoluteFilePath log -> "AbsoluteFilePath" <> colon <+> pretty log diff --git a/plugins/hls-module-name-plugin/test/Main.hs b/plugins/hls-module-name-plugin/test/Main.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/Main.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -module Main - ( main - ) where - -import Control.Monad (void) -import qualified Ide.Plugin.ModuleName as ModuleName -import System.FilePath -import Test.Hls - -main :: IO () -main = defaultTestRunner tests - -moduleNamePlugin :: PluginTestDescriptor ModuleName.Log -moduleNamePlugin = mkPluginTestDescriptor ModuleName.descriptor "moduleName" - -tests :: TestTree -tests = - testGroup "moduleName" - [ goldenWithModuleName "Add module header to empty module" "TEmptyModule" $ \doc -> do - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - - , goldenWithModuleName "Fix wrong module name" "TWrongModuleName" $ \doc -> do - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - - , goldenWithModuleName "Must infer module name as Main, if the file name starts with a lowercase" "mainlike" $ \doc -> do - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - - , goldenWithModuleName "Fix wrong module name in nested directory" "subdir/TWrongModuleName" $ \doc -> do - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - , testCase "Should not show code lens if the module name is correct" $ - runSessionWithServer def moduleNamePlugin testDataDir $ do - doc <- openDoc "CorrectName.hs" "haskell" - lenses <- getCodeLenses doc - liftIO $ lenses @?= [] - closeDoc doc - -- https://github.com/haskell/haskell-language-server/issues/3047 - , goldenWithModuleName "Fix#3047" "canonicalize/Lib/A" $ \doc -> do - [CodeLens { _command = Just c }] <- getCodeLenses doc - executeCommand c - void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) - , testCase "Keep stale lens even if parse failed" $ do - runSessionWithServer def moduleNamePlugin testDataDir $ do - doc <- openDoc "Stale.hs" "haskell" - oldLens <- getCodeLenses doc - let edit = TextEdit (mkRange 1 0 1 0) "f =" - _ <- applyEdit doc edit - newLens <- getCodeLenses doc - liftIO $ newLens @?= oldLens - closeDoc doc - ] - -goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithModuleName title path = goldenWithHaskellDoc def moduleNamePlugin title testDataDir path "expected" "hs" - -testDataDir :: FilePath -testDataDir = "plugins" "hls-module-name-plugin" "test" "testdata" diff --git a/plugins/hls-module-name-plugin/test/testdata/CorrectName.hs b/plugins/hls-module-name-plugin/test/testdata/CorrectName.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/CorrectName.hs +++ /dev/null @@ -1,1 +0,0 @@ -module CorrectName where diff --git a/plugins/hls-module-name-plugin/test/testdata/Stale.hs b/plugins/hls-module-name-plugin/test/testdata/Stale.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/Stale.hs +++ /dev/null @@ -1,1 +0,0 @@ -module Foo where diff --git a/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.expected.hs b/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.expected.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.expected.hs +++ /dev/null @@ -1,3 +0,0 @@ -module TEmptyModule where - - diff --git a/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.hs b/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/TEmptyModule.hs +++ /dev/null @@ -1,2 +0,0 @@ - - diff --git a/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.expected.hs b/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.expected.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module TWrongModuleName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.hs b/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/TWrongModuleName.hs +++ /dev/null @@ -1,7 +0,0 @@ -module BadName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/plugins/hls-module-name-plugin/test/testdata/cabal.project b/plugins/hls-module-name-plugin/test/testdata/cabal.project deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/cabal.project +++ /dev/null @@ -1,1 +0,0 @@ -packages: ./canonicalize diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs b/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.expected.hs +++ /dev/null @@ -1,1 +0,0 @@ -module Lib.A where diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs b/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/canonicalize/Lib/A.hs +++ /dev/null diff --git a/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal b/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/canonicalize/canonicalize.cabal +++ /dev/null @@ -1,7 +0,0 @@ -cabal-version: 2.4 -name: canonicalize -version: 0.1.0.0 - -library - build-depends: base - hs-source-dirs: ./ diff --git a/plugins/hls-module-name-plugin/test/testdata/hie.yaml b/plugins/hls-module-name-plugin/test/testdata/hie.yaml deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/hie.yaml +++ /dev/null @@ -1,17 +0,0 @@ -cradle: - multi: - - path: "./" - config: - cradle: - direct: - arguments: - - "-isubdir" - - "TEmptyModule" - - "TWrongModuleName" - - "CorrectName" - - path: "./canonicalize" - config: - cradle: - cabal: - - path: "./" - component: "lib:canonicalize" diff --git a/plugins/hls-module-name-plugin/test/testdata/mainlike.expected.hs b/plugins/hls-module-name-plugin/test/testdata/mainlike.expected.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/mainlike.expected.hs +++ /dev/null @@ -1,1 +0,0 @@ -module Main where diff --git a/plugins/hls-module-name-plugin/test/testdata/mainlike.hs b/plugins/hls-module-name-plugin/test/testdata/mainlike.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/mainlike.hs +++ /dev/null diff --git a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module TWrongModuleName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs b/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs deleted file mode 100644 --- a/plugins/hls-module-name-plugin/test/testdata/subdir/TWrongModuleName.hs +++ /dev/null @@ -1,7 +0,0 @@ -module BadName - ( x - ) -where - -x :: Integer -x = 11 diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -5,14 +5,13 @@ throwError) import Control.Monad.IO.Class (liftIO) import qualified Data.Array as A -import Data.Foldable (foldl') import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS -import Data.List (uncons) -import Data.Maybe (catMaybes, listToMaybe, - mapMaybe) -import Data.Text (Text, intercalate) +import Data.List as List +import Data.Maybe (catMaybes, fromMaybe, + listToMaybe, mapMaybe) +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Traversable (for) @@ -25,8 +24,8 @@ import Ide.Plugin.Error (PluginError (..)) import Ide.Types import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition, Method_TextDocumentReferences), - SMethod (SMethod_TextDocumentDefinition, SMethod_TextDocumentReferences)) +import Language.LSP.Protocol.Message (Method (Method_TextDocumentCompletion, Method_TextDocumentDefinition, Method_TextDocumentHover, Method_TextDocumentReferences), + SMethod (SMethod_TextDocumentCompletion, SMethod_TextDocumentDefinition, SMethod_TextDocumentHover, SMethod_TextDocumentReferences)) import Language.LSP.Protocol.Types import Text.Regex.TDFA (Regex, caseSensitive, defaultCompOpt, @@ -67,7 +66,7 @@ LogNoteReferencesFound file refs -> "Found note references in " <> prettyNotes file refs LogNotesFound file notes -> "Found notes in " <> prettyNotes file notes where prettyNotes file hm = pretty (show file) <> ": [" - <> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> intercalate ", " (map (T.pack . show) p)) hm)) <> "]" + <> pretty (T.intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> T.intercalate ", " (map (T.pack . show) p)) hm)) <> "]" {- The first time the user requests a jump-to-definition on a note reference, the @@ -80,6 +79,8 @@ , Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDefinition jumpToNote <> mkPluginHandler SMethod_TextDocumentReferences listReferences + <> mkPluginHandler SMethod_TextDocumentHover hoverNote + <> mkPluginHandler SMethod_TextDocumentCompletion autocomplete } findNotesRules :: Recorder (WithPriority Log) -> Rules () @@ -98,7 +99,7 @@ references <- fmap snd <$> use MkGetNotesInFile nfp pure $ fmap (HM.map (fmap (nfp,))) references ) - pure $ Just $ foldl' (HM.unionWith (<>)) HM.empty definedReferences + pure $ Just $ List.foldl' (HM.unionWith (<>)) HM.empty definedReferences err :: MonadError PluginError m => Text -> Maybe a -> m a err s = maybe (throwError $ PluginInternalError s) pure @@ -130,9 +131,14 @@ Nothing -> pure (InR Null) Just note -> do notes <- runActionE "notes.definedNoteReferencess" state $ useE MkGetNoteReferences nfp - poss <- err ("Note reference (a comment of the form `{- Note [" <> note <> "] -}`) not found") (HM.lookup note notes) - pure $ InL (mapMaybe (\(noteFp, pos@(Position l' _)) -> if l' == l then Nothing else Just ( - Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos))) poss) + case HM.lookup note notes of + Nothing -> pure (InL []) + Just poss -> pure $ InL $ mapMaybe (\(noteFp, pos@(Position l' _)) -> + if l' == l + then Nothing + else Just (Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos)) + ) + poss where uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) listReferences _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" @@ -146,10 +152,10 @@ Nothing -> pure (InR (InR Null)) Just note -> do notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes nfp - (noteFp, pos) <- err ("Note definition (a comment of the form `{- Note [" <> note <> "]\\n~~~ ... -}`) not found") (HM.lookup note notes) - pure $ InL (Definition (InL - (Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos)) - )) + case HM.lookup note notes of + Nothing -> pure (InR (InR Null)) + Just (noteFp, pos) -> pure $ InL $ Definition $ InL $ + Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos) where uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" @@ -168,7 +174,7 @@ let refMatches = (A.! 1) <$> matchAllText noteRefRegex content refs = toPositions refMatches content logWith recorder Debug $ LogNoteReferencesFound file (HM.toList refs) - pure $ Just (HM.mapMaybe (fmap fst . uncons) notes, refs) + pure $ Just (HM.mapMaybe (fmap fst . List.uncons) notes, refs) where uint = fromIntegral . toInteger -- the regex library returns the character index of the match. However @@ -190,8 +196,203 @@ noteRefRegex, noteRegex :: Regex (noteRefRegex, noteRegex) = - ( mkReg ("note \\[(.+)\\]" :: String) - , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*\r?\n[[:blank:]]*(--)?[[:blank:]]*~~~" :: String) + ( mkReg ("note[[:blank:]]?\\[(.+)\\]" :: String) + , mkReg ("note[[:blank:]]?\\[([[:print:]]+)\\][[:blank:]]*\r?\n[[:blank:]]*(--)?[[:blank:]]*~~~" :: String) ) where mkReg = makeRegexOpts (defaultCompOpt { caseSensitive = False }) defaultExecOpt + +-- | Find the precise range of `note[...]` or `note [...]` on a line. +findNoteRange + :: Text -- ^ Full line text + -> Text -- ^ Note title + -> UInt -- ^ Line number + -> Maybe Range +findNoteRange line _note lineNo = + case matchAllText noteRefRegex line of + [] -> Nothing + (arr:_) -> + case arr A.! 0 of + (_, (start, len)) -> + let startCol = fromIntegral start + endCol = startCol + fromIntegral len + in Just $ + Range + (Position lineNo startCol) + (Position lineNo endCol) + +-- Given the path and position of a Note Declaration, finds Content in it. +-- ignores ~ as a seprator +extractNoteContent + :: NormalizedFilePath + -> Position + -> IO (Maybe Text) +extractNoteContent nfp (Position startLine _) = do + fileText <- readFileUtf8 $ fromNormalizedFilePath nfp + + let allLines = T.lines fileText + headerLine = listToMaybe (drop (fromIntegral startLine) allLines) + isBlockNote = maybe False ("{-" `T.isInfixOf`) headerLine + isLineNote = maybe False (("--" `T.isPrefixOf`) . T.stripStart) headerLine + afterDecl = drop (fromIntegral startLine + 1) allLines + afterSeparator = + case dropWhile (not . isSeparatorLine) afterDecl of + [] -> [] + (_:xs) -> xs + isStopLine :: Text -> Bool + isStopLine t + | isBlockNote = isSeparatorLine t || isNoteHeader t || isEndMarker t + | isLineNote = isSeparatorLine t || isNoteHeader t || isEndMarker t || not ("--" `T.isPrefixOf` T.stripStart t) + | otherwise = isEndMarker t || isNoteHeader t + bodyLines = takeWhile (not . isStopLine) afterSeparator + + if null afterSeparator + then pure Nothing + else pure $ Just (T.unlines (map stripCommentPrefix bodyLines)) + + where + isSeparatorLine :: Text -> Bool + isSeparatorLine t = "~~~" `T.isInfixOf` t + + isNoteHeader :: Text -> Bool + isNoteHeader t = + let stripped = T.toLower (T.stripStart (stripCommentPrefix t)) + in "note [" `T.isPrefixOf` stripped + + isEndMarker :: Text -> Bool + isEndMarker t = "-}" `T.isInfixOf` t + + stripCommentPrefix :: Text -> Text + stripCommentPrefix t = + let s = T.stripStart t + in if "--" `T.isPrefixOf` s + then T.stripStart (T.drop 2 s) + else s + +normalizeNewlines :: Text -> Text +normalizeNewlines = T.replace "\r\n" "\n" + +-- on hovering Note References, shows corresponding Declaration if it Exists +-- ignores Note Declaration +hoverNote :: PluginMethodHandler IdeState Method_TextDocumentHover +hoverNote state _ params + | Just nfp <- uriToNormalizedFilePath uriOrig + = do + let pos@(Position line _) = params ^. L.position + noteOpt <- getNote nfp state pos + case noteOpt of + Nothing -> pure (InR Null) + + Just note -> do + mbRope <- liftIO $ runAction "notes.hoverLine" state (getFileContents nfp) + + -- compute precise hover range for highlighting corresponding Note Reference on Hover + let lineText = + case mbRope of + Nothing -> "" + Just rope -> fromMaybe "" $ listToMaybe $ drop (fromIntegral line) $ Rope.lines rope + + mbRange = findNoteRange lineText note line + + notes <- runActionE "notes.hover" state $ useE MkGetNotes nfp + case HM.lookup note notes of + Nothing -> pure $ InL $ Hover (InL $ MarkupContent MarkupKind_Markdown "_No declaration available_") mbRange + + Just (defFile, defPos) -> + if nfp == defFile && pos ^. L.line == defPos ^. L.line + then pure (InR Null) + else do + mbContent <- liftIO $ extractNoteContent defFile defPos + + let contents = + case mbContent of + Nothing -> "_No declaration available_" + Just body -> T.unlines [note, "", body] + normalizedContents = normalizeNewlines contents + + pure $ InL $ Hover (InL $ MarkupContent MarkupKind_Markdown normalizedContents) mbRange + where + uriOrig = toNormalizedUri $ params ^. (L.textDocument . L.uri) + +hoverNote _ _ _ = pure (InR Null) + +-- Gives an autocomplete suggestion when 'note' prefix is detected +autocomplete :: PluginMethodHandler IdeState Method_TextDocumentCompletion +autocomplete state _ params = do + let uri = params ^. (L.textDocument . L.uri) + pos = params ^. L.position + nuri = toNormalizedUri uri + + contents <- + liftIO $ + runAction "Notes.GetUriContents" state $ + getUriContents nuri + + fmap InL $ + case contents of + Nothing -> pure [] + + Just rope -> do + let linePrefix = T.toLower $ T.stripEnd $ getLinePrefix rope pos + + -- Suggest NOTE DECLARATION snippit if "note" prefix detected + if T.strip linePrefix == "note" + then + pure [CompletionItem "Note" Nothing (Just CompletionItemKind_Keyword) Nothing + (Just "Note Declaration") Nothing Nothing Nothing Nothing + Nothing (Just noteSnippet) (Just InsertTextFormat_Snippet) Nothing + Nothing Nothing Nothing Nothing Nothing Nothing + ] + + -- Suggest list of all NOTE DECLARATION if "note [" infix detected + else if "note[" `T.isInfixOf` linePrefix || "note [" `T.isInfixOf` linePrefix + then + case uriToNormalizedFilePath nuri of + Nothing -> pure [] + + Just nfp -> do + let typed = + case T.breakOnEnd "[" linePrefix of + (_, "") -> "" + (_, rest)-> T.strip rest + + notesMap <- + runActionE "notes.completion.notes" state $ + useE MkGetNotes nfp + + let allNotes = HM.keys notesMap + matches = + filter + (\n -> T.toLower typed `T.isPrefixOf` T.toLower n) + allNotes + + finalNotes = + if null matches then allNotes else matches + pure $ + map + (\n -> + CompletionItem n Nothing (Just CompletionItemKind_Reference) Nothing (Just "Note reference") + Nothing Nothing (Just True) (Just "0") (Just n) + Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + ) + finalNotes + else + pure [] + +noteSnippet :: Text +noteSnippet = + T.unlines + [ "{- Note [${1:Declaration title}]" + , "~~~" + , "${2:Content}" + , "-}" + ] + +getLinePrefix :: Rope.Rope -> Position -> Text +getLinePrefix rope (Position line col) = + case Rope.splitAtLine (fromIntegral line) rope of + (_, rest) -> + case Rope.lines rest of + (l:_) -> T.take (fromIntegral col) l + _ -> "" diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -1,5 +1,6 @@ module Main (main) where +import Data.List (sort) import Ide.Plugin.Notes (Log, descriptor) import System.FilePath (()) import Test.Hls @@ -12,6 +13,7 @@ testGroup "Notes" [ gotoNoteTests , noteReferenceTests + , hoverNoteTests ] runSessionWithServer' :: FilePath -> (FilePath -> Session a) -> IO a @@ -28,13 +30,15 @@ testCase "multi_file" $ runSessionWithServer' testDataDir $ \dir -> do doc <- openDoc "NoteDef.hs" "haskell" waitForKickDone - refs <- getReferences doc (Position 21 15) False - let fp = dir "NoteDef.hs" - liftIO $ refs @?= [ - Location (filePathToUri (dir "Other.hs")) (Range (Position 6 13) (Position 6 13)), - Location (filePathToUri fp) (Range (Position 9 9) (Position 9 9)), - Location (filePathToUri fp) (Range (Position 5 67) (Position 5 67)) - ] + refs0 <- getReferences doc (Position 21 15) False + let refs = sort refs0 + fp = dir "NoteDef.hs" + + liftIO $ sort refs @?= sort + [ Location (filePathToUri (dir "Other.hs")) (Range (Position 6 13) (Position 6 13)) + , Location (filePathToUri fp) (Range (Position 9 9) (Position 9 9)) + , Location (filePathToUri fp) (Range (Position 5 67) (Position 5 67)) + ] ] gotoNoteTests :: TestTree @@ -75,3 +79,83 @@ testDataDir :: FilePath testDataDir = "plugins" "hls-notes-plugin" "test" "testdata" + +hoverNoteTests :: TestTree +hoverNoteTests = testGroup "Hover Notes" + [ testCase "hover normal-notes" $ + runSessionWithServer' testDataDir $ \_dir -> do + let file = "HoverNote.hs" + pos = Position 24 10 + doc <- openDoc file "haskell" + waitForKickDone + hover <- getHover doc pos + + let expected = + Just $ Hover (InL $ MarkupContent MarkupKind_Markdown + "Normal-Notes\n\nContent of Normal Notes\n\n") + (Just (Range (Position 24 3) (Position 24 22))) + + liftIO $ hover @?= expected + + + , testCase "hover multi-notes-one" $ + runSessionWithServer' testDataDir $ \_dir -> do + let file = "HoverNote.hs" + pos = Position 25 10 + doc <- openDoc file "haskell" + waitForKickDone + hover <- getHover doc pos + + let expected = + Just $ Hover (InL $ MarkupContent MarkupKind_Markdown + "Multi-Notes-one\n\nContent of Multi-Notes-one\n\n\n") + (Just (Range (Position 25 3) (Position 25 25))) + + liftIO $ hover @?= expected + + + , testCase "hover multi-notes-two" $ + runSessionWithServer' testDataDir $ \_dir -> do + let file = "HoverNote.hs" + pos = Position 26 10 + doc <- openDoc file "haskell" + waitForKickDone + hover <- getHover doc pos + + let expected = + Just $ Hover (InL $ MarkupContent MarkupKind_Markdown + "Multi-Notes-two\n\nContent of Multi-Notes-two\n\n") + (Just (Range (Position 26 3) (Position 26 25))) + + liftIO $ hover @?= expected + + + , testCase "hover single-comment-declaration" $ + runSessionWithServer' testDataDir $ \_dir -> do + let file = "HoverNote.hs" + pos = Position 27 10 + doc <- openDoc file "haskell" + waitForKickDone + hover <- getHover doc pos + + let expected = + Just $ Hover (InL $ MarkupContent MarkupKind_Markdown + "Single Comment Declaration\n\nContent of Single Comment Declaration\n\n") + (Just (Range (Position 27 3) (Position 27 36))) + + liftIO $ hover @?= expected + + , testCase "hover single-comment leak" $ runSessionWithServer' testDataDir $ \_dir -> do + let file = "NoteDef.hs" + pos = Position 5 69 + doc <- openDoc file "haskell" + waitForKickDone + hover <- getHover doc pos + + let expected = + Just $ Hover (InL $ MarkupContent MarkupKind_Markdown + "Single line comments\n\nGHC's notes script only allows multiline comments to define notes, but in the\nHLS codebase this single line style can be found as well.\n\n") + (Just (Range (Position 5 61) (Position 5 88))) + + liftIO $ hover @?= expected + ] diff --git a/plugins/hls-notes-plugin/test/testdata/HoverNote.hs b/plugins/hls-notes-plugin/test/testdata/HoverNote.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-notes-plugin/test/testdata/HoverNote.hs @@ -0,0 +1,28 @@ +module HoverNotes where + +{- Note [Normal-Notes] +~~~ +Content of Normal Notes +-} + +{- Note [Multi-Notes-one] +~~~ +Content of Multi-Notes-one + +Note [Multi-Notes-two] +~~~ +Content of Multi-Notes-two +-} + +-- Note [Single Comment Declaration] +-- ~~~ +-- Content of Single Comment Declaration +-- -} + +foo :: Int +foo = 42 + +-- Note [Normal-Notes] +-- Note [Multi-Notes-one] +-- Note [Multi-Notes-two] +-- Note [Single Comment Declaration] diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -170,7 +170,12 @@ pure $ InL $ makeDiffTextEdit contents out ExitFailure n -> do logWith recorder Info $ StdErr err - throwError $ PluginInternalError $ "Ormolu failed with exit code " <> T.pack (show n) + let cleanErr = T.stripEnd err + let cliError = if T.null cleanErr + then "" + else "\n" <> cleanErr + throwError $ PluginInternalError $ + "Ormolu failed with exit code " <> T.pack (show n) <> cliError newtype CLIVersionInfo = CLIVersionInfo { noCabal :: Bool diff --git a/plugins/hls-ormolu-plugin/test/Main.hs b/plugins/hls-ormolu-plugin/test/Main.hs --- a/plugins/hls-ormolu-plugin/test/Main.hs +++ b/plugins/hls-ormolu-plugin/test/Main.hs @@ -4,11 +4,15 @@ ( main ) where +import Control.Lens ((^.)) import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Data.Functor +import qualified Data.Map as M +import qualified Data.Text as T import Ide.Plugin.Config import qualified Ide.Plugin.Ormolu as Ormolu +import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types import System.FilePath import Test.Hls @@ -31,6 +35,28 @@ , goldenWithOrmolu cli "formats operators correctly" "Ormolu3" "formatted" $ \doc -> do formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) #endif + , testCase "error message contains stderr output" $ do + let cliConfig = def { + formattingProvider = "ormolu", + plugins = M.fromList [("ormolu", def { plcConfig = KM.fromList ["external" .= True] })] + } + runSessionWithServer cliConfig ormoluPlugin testDataDir $ do + doc <- openDoc "FormatError.hs" "haskell" + void waitForBuildQueue + resp <- request SMethod_TextDocumentFormatting $ + DocumentFormattingParams Nothing doc (FormattingOptions 4 True Nothing Nothing Nothing) + liftIO $ case resp ^. L.result of + Left err -> do + let msg = err ^. L.message + -- Verify the error message structure: + -- 1. Contains the exit code prefix (base message intact) + assertBool ("Expected exit code prefix, got: " <> T.unpack msg) + ("failed with exit code" `T.isInfixOf` msg) + -- 2. Contains a stable parse-error phrase from formatter stderr + assertBool ("Expected parse error details from stderr, got: " <> T.unpack msg) + ("parse error on input" `T.isInfixOf` msg) + Right _ -> + assertFailure "Expected formatting to fail on unparsable file" ] goldenWithOrmolu :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree diff --git a/plugins/hls-ormolu-plugin/test/testdata/FormatError.hs b/plugins/hls-ormolu-plugin/test/testdata/FormatError.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-ormolu-plugin/test/testdata/FormatError.hs @@ -0,0 +1,3 @@ +module FormatError where + +foo = let x = 1 in in x diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -964,7 +964,7 @@ [modul, "(from", _] -> Just modul _ -> Nothing -suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)] +suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, CodeActionPreferred, Rewrite)] suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message @@ -992,6 +992,7 @@ Just ident <- lookupExportMap binding mod = [ ( "Add " <> renderImportStyle importStyle <> " to the import list of " <> mod , quickFixImportKind' "extend" importStyle + , True , uncurry extendImport (unImportStyle importStyle) decl ) | importStyle <- NE.toList $ importStyles ident @@ -1434,7 +1435,7 @@ ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] +suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, CodeActionPreferred, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message} | Just [methodName, className] <- matchRegexUnifySpaces @@ -1454,6 +1455,7 @@ Just decl -> [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleText, quickFixImportKind' "extend" style, + True, [Right $ uncurry extendImport (unImportStyle style) decl] ) | style <- importStyle @@ -1462,7 +1464,7 @@ _ | Just (range, indent) <- newImportInsertRange ps fileContents -> - (\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> + (\(kind, unNewImport -> x) -> (x, kind, True, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> [ (quickFixImportKind' "new" style, newUnqualImport moduleText rendered False) | style <- importStyle, let rendered = renderImportStyle style @@ -1471,7 +1473,7 @@ | otherwise -> [] where moduleText = moduleNameText identInfo -suggestNewImport :: DynFlags -> ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestNewImport :: DynFlags -> ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, CodeActionPreferred, TextEdit)] suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg @@ -1491,7 +1493,7 @@ = let qis = qualifiedImportStyle df suggestions = nubSortBy simpleCompareImportSuggestion (constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions qis) in - map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions + map (\(ImportSuggestion _ kind (unNewImport -> imp)) -> (imp, kind, True, TextEdit range (imp <> "\n" <> T.replicate indent " "))) suggestions where L _ HsModule {..} = ps suggestNewImport _ _ _ _ _ = [] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -141,6 +141,13 @@ dropHsParTy (L _ (HsParTy _ ty)) = ty dropHsParTy other = other +normalizeConstraintDP :: [LocatedAn AnnListItem (HsType GhcPs)] -> [LocatedAn AnnListItem (HsType GhcPs)] +normalizeConstraintDP [] = [] +normalizeConstraintDP xs = normalizeFirst xs + where + normalizeFirst (x:rest) = setEntryDP x (SameLine 0) : rest + normalizeFirst [] = [] + removeConstraint :: -- | Predicate: Which context to drop. (LHsType GhcPs -> Bool) -> @@ -154,15 +161,13 @@ #else go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do #endif - let ctxt' = filter (not . toRemove) ctxt - removeStuff = (toRemove <$> headMaybe ctxt) == Just True - let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body + let ctxt' = normalizeConstraintDP $ filter (not . toRemove) ctxt return $ case ctxt' of - [] -> hst_body' + [] -> hst_body _ -> do let ctxt'' = over _last (first removeComma) ctxt' L l $ it{ hst_ctxt = L l' ctxt'' - , hst_body = hst_body' + , hst_body = hst_body } go (L _ (HsParTy _ ty)) = go ty go (L _ HsForAllTy{hst_body}) = go hst_body @@ -243,11 +248,6 @@ liftParseAST df s = case parseAST df "" s of Right x -> pure (makeDeltaAst x) Left _ -> TransformT $ lift $ Left $ "No parse: " <> s - - -headMaybe :: [a] -> Maybe a -headMaybe [] = Nothing -headMaybe (a : _) = Just a lastMaybe :: [a] -> Maybe a lastMaybe [] = Nothing diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -4,6 +4,7 @@ import Control.Monad (join) import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..)) +import Data.Char (isUpper) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T import Development.IDE.GHC.Compat @@ -68,11 +69,20 @@ -- In this case a new argument would have to add its type between b and c in the signature. plugin :: ParsedModule -> Diagnostic -> Either PluginError [(T.Text, [TextEdit])] plugin parsedModule Diagnostic {_message, _range} - | Just (name, typ) <- matchVariableNotInScope message = addArgumentAction parsedModule _range name typ + | Just (name, typ) <- matchVariableNotInScope message + , not (isQualifiedName name) = addArgumentAction parsedModule _range name typ | Just (name, typ) <- matchFoundHoleIncludeUnderscore message = addArgumentAction parsedModule _range name (Just typ) | otherwise = pure [] where message = unifySpaces _message + -- Qualified names (e.g. NE.toList) always start with an uppercase module + -- qualifier. Since "Variable not in scope" only reports variables and + -- operators, an unqualified name will never start with an uppercase letter. + -- Therefore, checking for an uppercase first character reliably identifies + -- qualified names, which can never be valid function argument patterns. + isQualifiedName name = case T.uncons name of + Just (c, _) -> isUpper c + Nothing -> False -- Given a name for the new binding, add a new pattern to the match in the last position, -- returning how many patterns there were in this match prior to the transformation: diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -3288,7 +3288,7 @@ ] typeSignatureLined3 = T.unlines $ header <> - [ "foo :: ( Eq a" + [ "foo :: (Eq a" , " , Show a" , " )" , " => a -> Bool" @@ -3296,7 +3296,7 @@ ] typeSignatureLined3' = T.unlines $ header <> - [ "foo :: ( Eq a" + [ "foo :: (Eq a" , " )" , " => a -> Bool" , "foo x = x == x" diff --git a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs --- a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs @@ -3,10 +3,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Test.AddArgument (tests) where +import Data.List (find) +import Data.Maybe (isJust) import qualified Data.Text as T import Development.IDE.Types.Location import Language.LSP.Protocol.Types hiding @@ -42,7 +45,8 @@ mkGoldenAddArgTest "AddArgWithLambda" (r 1 0 1 50), mkGoldenAddArgTest "MultiSigFirst" (r 2 0 2 50), mkGoldenAddArgTest "MultiSigLast" (r 2 0 2 50), - mkGoldenAddArgTest "MultiSigMiddle" (r 2 0 2 50) + mkGoldenAddArgTest "MultiSigMiddle" (r 2 0 2 50), + mkNoAddArgForQualifiedNameTest ] where r x y x' y' = Range (Position x y) (Position x' y') @@ -71,3 +75,30 @@ "expected" "hs" action + +-- | Verify that the "Add argument" code action is NOT offered for qualified names (e.g. NE.toList). +-- We also verify that an import suggestion IS offered, to confirm we're testing the right diagnostic. +mkNoAddArgForQualifiedNameTest :: TestTree +mkNoAddArgForQualifiedNameTest = + testCase "No add argument for qualified names" $ runSessionWithServerInTmpDir def + ( mkPluginTestDescriptor Refactor.iePluginDescriptor "ghcide-code-actions-imports-exports" + <> mkPluginTestDescriptor Refactor.bindingsPluginDescriptor "ghcide-code-actions-bindings" + ) + (FS.mkVirtualFileTree "plugins/hls-refactor-plugin/test/data/add-arg" (FS.directProject "QualifiedName.hs")) + $ do + doc <- openDoc "QualifiedName.hs" "haskell" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position 5 0) (Position 5 50)) + -- Verify that an import suggestion exists, confirming the right diagnostic. + let importAction = find (\case + InR CodeAction {_title = t} -> "Data.List.NonEmpty" `T.isInfixOf` t + _ -> False) actions + liftIO $ assertBool + "Expected an import suggestion code action for Data.List.NonEmpty" + (isJust importAction) + -- Verify that the "Add argument" code action is NOT offered + let addArgAction = find (\case + InR CodeAction {_title = t} -> "Add argument" `T.isPrefixOf` t + _ -> False) actions + liftIO $ addArgAction @?= Nothing + diff --git a/plugins/hls-refactor-plugin/test/data/add-arg/QualifiedName.hs b/plugins/hls-refactor-plugin/test/data/add-arg/QualifiedName.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/add-arg/QualifiedName.hs @@ -0,0 +1,6 @@ +module QualifiedName where + +import Data.List.NonEmpty (NonEmpty(..)) + +foo :: NonEmpty a -> [a] +foo xs = NE.toList xs diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -5,8 +5,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE LambdaCase #-} -module Ide.Plugin.Rename (descriptor, E.Log) where +module Ide.Plugin.Rename (descriptor, Log) where import Control.Lens ((^.)) import Control.Monad @@ -30,12 +31,12 @@ import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils import Development.IDE.Core.RuleTypes -import Development.IDE.Core.Service -import Development.IDE.Core.Shake +import Development.IDE.Core.Service hiding (Log) +import Development.IDE.Core.Shake hiding (Log) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.ExactPrint import Development.IDE.GHC.Error -import Development.IDE.GHC.ExactPrint +import Development.IDE.GHC.ExactPrint hiding (Log) import qualified Development.IDE.GHC.ExactPrint as E import Development.IDE.Plugin.CodeAction import Development.IDE.Spans.AtPoint @@ -48,8 +49,11 @@ import HieDb ((:.) (..)) import HieDb.Query import HieDb.Types (RefRow (refIsGenerated)) +import Ide.Logger (Pretty (..), + cmapWithPrio) import Ide.Plugin.Error import Ide.Plugin.Properties +import qualified Ide.Plugin.Rename.ModuleName as ModuleName import Ide.PluginUtils import Ide.Types import qualified Language.LSP.Protocol.Lens as L @@ -58,30 +62,50 @@ instance Hashable (Mod a) where hash n = hash (unMod n) -descriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ - (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers") +data Log + = LogExactPrint E.Log + | LogModuleName ModuleName.Log + +instance Pretty Log where + pretty = \ case + LogExactPrint msg -> pretty msg + LogModuleName msg -> pretty msg + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder pluginId = mkExactprintPluginDescriptor exactPrintRecorder $ + (defaultPluginDescriptor pluginId "Provides renaming of Haskell identifiers and module names") { pluginHandlers = mconcat [ mkPluginHandler SMethod_TextDocumentRename renameProvider , mkPluginHandler SMethod_TextDocumentPrepareRename prepareRenameProvider + , mkPluginHandler SMethod_TextDocumentCodeLens (ModuleName.codeLens moduleNameRecorder) ] + , pluginCommands = [PluginCommand ModuleName.updateModuleNameCommand "Set name of module to match with file path" (ModuleName.command moduleNameRecorder)] , pluginConfigDescriptor = defaultConfigDescriptor { configCustomConfig = mkCustomConfig properties } } + where + exactPrintRecorder = cmapWithPrio LogExactPrint recorder + moduleNameRecorder = cmapWithPrio LogModuleName recorder prepareRenameProvider :: PluginMethodHandler IdeState Method_TextDocumentPrepareRename prepareRenameProvider state _pluginId (PrepareRenameParams (TextDocumentIdentifier uri) pos _progressToken) = do nfp <- getNormalizedFilePathE uri - namesUnderCursor <- getNamesAtPos state nfp pos + HAR{hieAst} <- handleGetHieAst state nfp + let spansWithNamesUnderCursor = + [ srcSpan + | (names, srcSpan) <- getNamesSpansAtPoint' hieAst pos + , not (null names)] -- When this handler says that rename is invalid, VSCode shows "The element can't be renamed" -- and doesn't even allow you to create full rename request. -- This handler deliberately approximates "things that definitely can't be renamed" - -- to mean "there is no Name at given position". + -- to mean "there is no Name at given position" (in which case + -- `spansWithNamesUnderCursor` would be empty). -- -- In particular it allows some cases through (e.g. cross-module renames), -- so that the full rename handler can give more informative error about them. - let renameValid = not $ null namesUnderCursor - pure $ InL $ PrepareRenameResult $ InR $ InR $ PrepareRenameDefaultBehavior renameValid + pure $ case spansWithNamesUnderCursor of + [] -> InR Null + srcSpan : _ -> InL $ PrepareRenameResult $ InL (realSrcSpanToRange srcSpan) renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do @@ -269,6 +293,12 @@ getNamesAtPoint' hf pos = concat $ pointCommand hf pos (rights . M.keys . getNodeIds) +-- | A variant of `getNamesAtPoint'` that also returns source spans. +getNamesSpansAtPoint' :: HieASTs a -> Position -> [([Name], RealSrcSpan)] +getNamesSpansAtPoint' hf pos = + pointCommand hf pos $ + \astNode -> (rights . M.keys . getNodeIds $ astNode, nodeSpan astNode) + locToUri :: Location -> Uri locToUri (Location uri _) = uri @@ -291,4 +321,4 @@ properties :: Properties '[ 'PropertyKey "crossModule" 'TBoolean] properties = emptyProperties & defineBooleanProperty #crossModule - "Enable experimental cross-module renaming" False + "Enable experimental cross-module renaming" True diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ModuleName.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +{- | Keep the module name in sync with its file path. + +Provide CodeLenses to: +* Add a module header ("module /moduleName/ where") to empty Haskell files +* Fix the module name if incorrect +-} +module Ide.Plugin.Rename.ModuleName ( + Log, + codeLens, + updateModuleNameCommand, + command, +) where + +import Control.Monad (forM_, void) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Data.Aeson (toJSON) +import Data.Char (isLower, isUpper) +import Data.List (intercalate, minimumBy, + stripPrefix) +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map +import Data.Maybe (mapMaybe) +import Data.Ord (comparing) +import Data.String (IsString) +import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE (GetParsedModule (GetParsedModule), + GhcSession (GhcSession), + IdeState, Pretty, + Priority (Debug), + Recorder, WithPriority, + colon, evalGhcEnv, + hscEnv, logWith, + realSrcSpanToRange, + rootDir, runAction, + useWithStale, (<+>)) +import Development.IDE.Core.FileStore (getFileContents) +import Development.IDE.Core.PluginUtils +import Development.IDE.Core.PositionMapping (toCurrentRange) +import Development.IDE.GHC.Compat (GenLocated (L), + getSessionDynFlags, + hsmodName, importPaths, + locA, moduleNameString, + pattern RealSrcSpan, + pm_parsed_source, unLoc) +import Ide.Logger (Pretty (..)) +import Ide.Plugin.Error +import Ide.PluginUtils (toAbsolute) +import Ide.Types +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types +import System.FilePath (dropExtension, normalise, + pathSeparator, + splitDirectories, + takeFileName) + +updateModuleNameCommand :: IsString p => p +updateModuleNameCommand = "updateModuleName" + +-- | Generate code lenses +codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens +codeLens recorder state pluginId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do + res <- action recorder state uri + pure $ InL (asCodeLens <$> res) + where + asCodeLens :: Action -> CodeLens + asCodeLens Replace{..} = CodeLens aRange (Just cmd) Nothing + where + cmd = mkLspCommand pluginId updateModuleNameCommand aTitle (Just [toJSON aUri]) + +-- | (Quasi) Idempotent command execution: recalculate action to execute on command request +command :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri +command recorder state _ uri = do + actMaybe <- action recorder state uri + forM_ actMaybe $ \Replace{..} -> + let + -- | Convert an Action to the corresponding edit operation + edit = WorkspaceEdit (Just $ Map.singleton aUri [TextEdit aRange aCode]) Nothing Nothing + in + void $ lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (const (pure ())) + pure $ InR Null + +-- | A source code change +data Action = Replace + { aUri :: Uri + , aRange :: Range + , aTitle :: T.Text + , aCode :: T.Text + } + deriving (Show) + +-- | Required action (that can be converted to either CodeLenses or CodeActions) +action :: Recorder (WithPriority Log) -> IdeState -> Uri -> ExceptT PluginError (HandlerM c) [Action] +action recorder state uri = do + nfp <- getNormalizedFilePathE uri + fp <- uriToFilePathE uri + + contents <- liftIO $ runAction "ModuleName.getFileContents" state $ getFileContents nfp + let emptyModule = maybe True (T.null . T.strip . Rope.toText) contents + + correctNames <- mapExceptT liftIO $ pathModuleNames recorder state nfp fp + logWith recorder Debug (CorrectNames correctNames) + let bestName = minimumBy (comparing T.length) <$> NE.nonEmpty correctNames + logWith recorder Debug (BestName bestName) + + statedNameMaybe <- liftIO $ codeModuleName state nfp + logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe) + case (bestName, statedNameMaybe) of + (Just bestName, Just (nameRange, statedName)) + | statedName `notElem` correctNames -> + pure [Replace uri nameRange ("Set module name to " <> bestName) bestName] + (Just bestName, Nothing) + | emptyModule -> + let code = "module " <> bestName <> " where\n" + in pure [Replace uri (Range (Position 0 0) (Position 0 0)) code code] + _ -> pure [] + +-- | Possible module names, as derived by the position of the module in the +-- source directories. There may be more than one possible name, if the source +-- directories are nested inside each other. +pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text] +pathModuleNames recorder state normFilePath filePath + | firstLetter isLower $ takeFileName filePath = return ["Main"] + | otherwise = do + (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath + srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags + logWith recorder Debug (SrcPaths srcPaths) + + -- Append a `pathSeparator` to make the path looks like a directory, + -- and then we can drop it uniformly. + -- See https://github.com/haskell/haskell-language-server/pull/3092 for details. + let paths = map (normalise . (<> pure pathSeparator)) srcPaths + logWith recorder Debug (NormalisedPaths paths) + + -- TODO, this can be avoid if the filePath is already absolute, + -- we can avoid the toAbsolute call in the future. + -- see Note [Root Directory] + let mdlPath = (toAbsolute $ rootDir state) filePath + logWith recorder Debug (AbsoluteFilePath mdlPath) + + let suffixes = mapMaybe (`stripPrefix` mdlPath) paths + pure (map moduleNameFrom suffixes) + where + firstLetter :: (Char -> Bool) -> FilePath -> Bool + firstLetter _ [] = False + firstLetter pred (c:_) = pred c + + moduleNameFrom = + T.pack + . intercalate "." + -- Do not suggest names whose components start from a lower-case char, + -- they are guaranteed to be malformed. + . filter (firstLetter isUpper) + . splitDirectories + . dropExtension + +-- | The module name, as stated in the module +codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) +codeModuleName state nfp = runMaybeT $ do + (pm, mp) <- MaybeT . runAction "ModuleName.GetParsedModule" state $ useWithStale GetParsedModule nfp + L (locA -> (RealSrcSpan l _)) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm + range <- MaybeT . pure $ toCurrentRange mp (realSrcSpanToRange l) + pure (range, T.pack $ moduleNameString m) + +data Log = + CorrectNames [T.Text] + | BestName (Maybe T.Text) + | ModuleName (Maybe T.Text) + | SrcPaths [FilePath] + | NormalisedPaths [FilePath] + | AbsoluteFilePath FilePath + deriving Show + +instance Pretty Log where + pretty log = "ModuleName." <> case log of + CorrectNames log -> "CorrectNames" <> colon <+> pretty log + BestName log -> "BestName" <> colon <+> pretty log + ModuleName log -> "StatedNameMaybe" <> colon <+> pretty log + SrcPaths log -> "SrcPaths" <> colon <+> pretty log + NormalisedPaths log -> "NormalisedPaths" <> colon <+> pretty log + AbsoluteFilePath log -> "AbsoluteFilePath" <> colon <+> pretty log diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -4,13 +4,15 @@ module Main (main) where -import Control.Lens ((^.)) -import Data.Aeson -import qualified Data.Map as M -import Data.Text (Text, pack) +import Control.Lens ((^.)) +import Data.Aeson (KeyValue ((.=))) +import Data.Functor (void) +import qualified Data.Map as M +import Data.Text (Text, pack) import Ide.Plugin.Config -import qualified Ide.Plugin.Rename as Rename -import qualified Language.LSP.Protocol.Lens as L +import qualified Ide.Plugin.Rename as Rename +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Types (Null (Null)) import System.FilePath import Test.Hls @@ -22,6 +24,56 @@ tests :: TestTree tests = testGroup "Rename" + [ prepareRenameTests + , renameTests + , moduleNameTests + ] + +prepareRenameTests :: TestTree +prepareRenameTests = testGroup "PrepareRename" + [ testCase "Module name (not yet renameable)" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 0 9) + liftIO $ result @?= InR Null + + , testCase "Function name" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 8 1) + liftIO $ result @?= + InL (PrepareRenameResult (InL (Range (Position 8 0) (Position 8 3)))) + + , testCase "Imported function name" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 10 16) + liftIO $ result @?= + InL (PrepareRenameResult (InL (Range (Position 10 14) (Position 10 19)))) + + , testCase "Non-renameable position" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 6 23) + liftIO $ result @?= InR Null + + , testCase "Operator" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 10 7) + liftIO $ result @?= + InL (PrepareRenameResult (InL (Range (Position 10 6) (Position 10 9)))) + + , testCase "Built-in operator" $ runRenameSession "" $ do + doc <- openDoc "PrepareRename.hs" "haskell" + void waitForBuildQueue + result <- prepareRename doc (Position 13 7) + liftIO $ result @?= + InL (PrepareRenameResult (InL (Range (Position 13 7) (Position 13 8)))) + ] + +renameTests :: TestTree +renameTests = testGroup "Identifier" [ goldenWithRename "Data constructor" "DataConstructor" $ \doc -> rename doc (Position 0 15) "Op" , goldenWithRename "Data constructor with fields" "DataConstructorWithFields" $ \doc -> @@ -113,10 +165,70 @@ rename doc (Position 3 0) "foo'" ] +moduleNameTests :: TestTree +moduleNameTests = + testGroup "ModuleName" + [ goldenWithModuleName "Add module header to empty module" "TEmptyModule" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + + , goldenWithModuleName "Fix wrong module name" "TWrongModuleName" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + + , goldenWithModuleName "Must infer module name as Main, if the file name starts with a lowercase" "mainlike" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + + , goldenWithModuleName "Fix wrong module name in nested directory" "subdir/TWrongModuleName" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + , testCase "Should not show code lens if the module name is correct" $ + runSessionWithServer def renamePlugin modNameTestDataDir $ do + doc <- openDoc "CorrectName.hs" "haskell" + lenses <- getCodeLenses doc + liftIO $ lenses @?= [] + closeDoc doc + -- https://github.com/haskell/haskell-language-server/issues/3047 + , goldenWithModuleName "Fix#3047" "canonicalize/Lib/A" $ \doc -> do + [CodeLens { _command = Just c }] <- getCodeLenses doc + executeCommand c + void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) + , testCase "Keep stale lens even if parse failed" $ do + runSessionWithServer def renamePlugin modNameTestDataDir $ do + doc <- openDoc "Stale.hs" "haskell" + oldLens <- getCodeLenses doc + let edit = TextEdit (mkRange 1 0 1 0) "f =" + _ <- applyEdit doc edit + newLens <- getCodeLenses doc + liftIO $ newLens @?= oldLens + closeDoc doc + ] + +goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +goldenWithModuleName title path = goldenWithHaskellDoc def renamePlugin title modNameTestDataDir path "expected" "hs" + +modNameTestDataDir :: FilePath +modNameTestDataDir = testDataDir "mod_name" + goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithRename title path act = goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] }) renamePlugin title testDataDir path "expected" "hs" act + +-- NOTE: This should eventually be moved upstream to lsp-test (see +-- https://github.com/haskell/lsp/issues/636). +prepareRename :: TextDocumentIdentifier -> Position -> Session (PrepareRenameResult |? Null) +prepareRename doc pos = do + let params = PrepareRenameParams doc pos Nothing + rsp <- request SMethod_TextDocumentPrepareRename params + case rsp ^. L.result of + Left rspError -> liftIO $ assertFailure $ "prepareRename failed: " <> show rspError + Right rspResult -> pure rspResult renameExpectError :: TResponseError Method_TextDocumentRename -> TextDocumentIdentifier -> Position -> Text -> Session () renameExpectError expectedError doc pos newName = do diff --git a/plugins/hls-rename-plugin/test/testdata/PrepareRename.hs b/plugins/hls-rename-plugin/test/testdata/PrepareRename.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/PrepareRename.hs @@ -0,0 +1,14 @@ +module PrepareRename where + +import qualified Foo as F + +main :: IO Int +main = do + x <- return $ foo 42 + return (foo x) +foo, bar :: Int -> Int +foo x = x + 1 +bar = (+) 1 . F.foo . foo + +baz :: a -> [a] +baz = (: []) diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/CorrectName.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/CorrectName.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/CorrectName.hs @@ -0,0 +1,1 @@ +module CorrectName where diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/Stale.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/Stale.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/Stale.hs @@ -0,0 +1,1 @@ +module Foo where diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.expected.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.expected.hs @@ -0,0 +1,3 @@ +module TEmptyModule where + + diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/TEmptyModule.hs @@ -0,0 +1,2 @@ + + diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.expected.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.expected.hs @@ -0,0 +1,7 @@ +module TWrongModuleName + ( x + ) +where + +x :: Integer +x = 11 diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/TWrongModuleName.hs @@ -0,0 +1,7 @@ +module BadName + ( x + ) +where + +x :: Integer +x = 11 diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/cabal.project b/plugins/hls-rename-plugin/test/testdata/mod_name/cabal.project new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/cabal.project @@ -0,0 +1,1 @@ +packages: ./canonicalize diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.expected.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.expected.hs @@ -0,0 +1,1 @@ +module Lib.A where diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/Lib/A.hs diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/canonicalize.cabal b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/canonicalize.cabal new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/canonicalize/canonicalize.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.4 +name: canonicalize +version: 0.1.0.0 + +library + build-depends: base + hs-source-dirs: ./ diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/hie.yaml b/plugins/hls-rename-plugin/test/testdata/mod_name/hie.yaml new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/hie.yaml @@ -0,0 +1,17 @@ +cradle: + multi: + - path: "./" + config: + cradle: + direct: + arguments: + - "-isubdir" + - "TEmptyModule" + - "TWrongModuleName" + - "CorrectName" + - path: "./canonicalize" + config: + cradle: + cabal: + - path: "./" + component: "lib:canonicalize" diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.expected.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.expected.hs @@ -0,0 +1,1 @@ +module Main where diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/mainlike.hs diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.expected.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.expected.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.expected.hs @@ -0,0 +1,7 @@ +module TWrongModuleName + ( x + ) +where + +x :: Integer +x = 11 diff --git a/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.hs b/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.hs new file mode 100644 --- /dev/null +++ b/plugins/hls-rename-plugin/test/testdata/mod_name/subdir/TWrongModuleName.hs @@ -0,0 +1,7 @@ +module BadName + ( x + ) +where + +x :: Integer +x = 11 diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs --- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs +++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs @@ -22,6 +22,7 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types +import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Test as Test import Language.LSP.VFS (VirtualFile (..)) import System.FilePath @@ -90,7 +91,7 @@ docLspSemanticTokensString doc = do res <- Test.getSemanticTokens doc textContent <- documentContents doc - let vfs = VirtualFile 0 0 (Rope.fromText textContent) + let vfs = VirtualFile 0 0 (Rope.fromText textContent) $ Just J.LanguageKind_Haskell case res ^? Language.LSP.Protocol.Types._L of Just tokens -> do either (error . show) pure $ recoverLspSemanticTokens vfs tokens diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -2,14 +2,10 @@ {-# LANGUAGE QuasiQuotes #-} import Control.Arrow ((>>>)) -import Control.Exception (throw) -import Control.Lens ((^.)) -import Data.Maybe (fromJust) import Data.Text (Text) import qualified Data.Text as T import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (PosPrefixInfo)) import Ide.Plugin.SignatureHelp (descriptor) -import qualified Language.LSP.Protocol.Lens as L import Test.Hls import Test.Hls.FileSystem (VirtualFileTree, directCradle, file, @@ -411,7 +407,7 @@ virtualFileTree = mkVirtualFileTreeWithSingleFile fileName sourceCode in runSessionWithServerInTmpDir def plugin virtualFileTree $ do doc <- openDoc fileName "haskell" - (fmap . fmap) SimilarSignatureHelp (getSignatureHelp doc position) + (fmap . fmap) SimilarSignatureHelp (getSignatureHelp doc position Nothing) mkVirtualFileTreeWithSingleFile :: FilePath -> Text -> VirtualFileTree mkVirtualFileTreeWithSingleFile fileName sourceCode = @@ -499,16 +495,3 @@ InL x ~= InL y = x ~= y InR x ~= InR y = x ~= y _ ~= _ = False - --- TODO use the one from lsp-test when we have https://github.com/haskell/lsp/pull/621 - --- | Returns the signature help at the specified position. -getSignatureHelp :: TextDocumentIdentifier -> Position -> Session (Maybe SignatureHelp) -getSignatureHelp doc pos = - let params = SignatureHelpParams doc pos Nothing Nothing - in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentSignatureHelp params - where - getResponseResult rsp = - case rsp ^. L.result of - Right x -> x - Left err -> throw $ UnexpectedResponseError (fromJust $ rsp ^. L.id) err diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -25,8 +25,11 @@ import Ide.Types hiding (Config) import Language.Haskell.Stylish import Language.LSP.Protocol.Types as LSP -import System.Directory import System.FilePath + +#if !MIN_VERSION_stylish_haskell(0,15,0) +import System.Directory +#endif data Log = LogLanguageExtensionFromDynFlags diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -103,10 +103,6 @@ -- formatters -#if hls_floskell -import qualified Ide.Plugin.Floskell as Floskell -#endif - #if hls_fourmolu import qualified Ide.Plugin.Fourmolu as Fourmolu #endif @@ -162,9 +158,6 @@ Pragmas.suggestPragmaDescriptor "pragmas-suggest" : Pragmas.completionDescriptor "pragmas-completion" : Pragmas.suggestDisableWarningDescriptor "pragmas-disable" : -#endif -#if hls_floskell - Floskell.descriptor "floskell" : #endif #if hls_fourmolu let pId = "fourmolu" in Fourmolu.descriptor (pluginRecorder pId) pId: diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -22,6 +22,7 @@ import Ide.Types (IdePlugins) import Options.Applicative import Paths_haskell_language_server +import System.Directory (getCurrentDirectory) import System.Environment -- --------------------------------------------------------------------- @@ -38,18 +39,19 @@ | PrintLibDir data GhcideArguments = GhcideArguments - { argsCommand :: Command - , argsCwd :: Maybe FilePath - , argsShakeProfiling :: Maybe FilePath - , argsTesting :: Bool - , argsExamplePlugin :: Bool - , argsLogLevel :: Priority - , argsLogFile :: Maybe String + { argsCommand :: Command + , argsCwd :: Maybe FilePath + , argsShakeProfiling :: Maybe FilePath + , argsTesting :: Bool + , argsExamplePlugin :: Bool + , argsLogLevel :: Priority + , argsLogFile :: Maybe String -- ^ the minimum log level to show - , argsLogStderr :: Bool - , argsLogClient :: Bool - , argsThreads :: Int - , argsProjectGhcVersion :: Bool + , argsLogStderr :: Bool + , argsLogClient :: Bool + , argsThreads :: Int + , argsProjectGhcVersion :: Bool + , argsInitialWorkingDirectory :: FilePath } deriving Show data PrintVersion @@ -62,9 +64,11 @@ deriving (Show, Eq, Ord) getArguments :: String -> IdePlugins IdeState -> IO Arguments -getArguments exeName plugins = execParser opts +getArguments exeName plugins = do + cwd <- getCurrentDirectory + execParser (opts cwd) where - opts = info (( + opts cwd = info (( VersionMode <$> printVersionParser exeName <|> probeToolsParser exeName <|> hsubparser @@ -74,7 +78,7 @@ ) <|> listPluginsParser <|> BiosMode <$> biosParser - <|> Ghcide <$> arguments plugins + <|> Ghcide <$> arguments cwd plugins <|> flag' PrintLibDir (long "print-libdir" <> help "Print project GHCs libdir") ) <**> helper) @@ -115,8 +119,8 @@ flag' ListPluginsMode (long "list-plugins" <> help "List all available plugins") -arguments :: IdePlugins IdeState -> Parser GhcideArguments -arguments plugins = GhcideArguments +arguments :: FilePath -> IdePlugins IdeState -> Parser GhcideArguments +arguments cwd plugins = GhcideArguments <$> (commandP plugins <|> lspCommand <|> checkCommand) <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") @@ -186,6 +190,7 @@ ) <*> switch (long "project-ghc-version" <> help "Work out the project GHC version and print it") + <*> pure cwd where lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server") checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) diff --git a/test/functional/Format.hs b/test/functional/Format.hs --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Format (tests) where @@ -13,7 +12,7 @@ import Language.LSP.Test import Test.Hls import Test.Hls.Command -import Test.Hls.Flags (requiresFloskellPlugin, +import Test.Hls.Flags (requiresFourmoluPlugin, requiresOrmoluPlugin) tests :: TestTree @@ -34,11 +33,11 @@ _ -> 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" $ runSessionWithConfig (formatConfig "none") hlsLspCommand fullLatestClientCaps "test/testdata/format" $ do + , requiresOrmoluPlugin . requiresFourmoluPlugin $ testCase "can change on the fly" $ runSessionWithConfig (formatConfig "none") hlsLspCommand fullLatestClientCaps "test/testdata/format" $ do void configurationRequest formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" - formattedFloskell <- liftIO $ T.readFile "test/testdata/format/Format.floskell.formatted.hs" - formattedOrmoluPostFloskell <- liftIO $ T.readFile "test/testdata/format/Format.ormolu_post_floskell.formatted.hs" + formattedFourmolu <- liftIO $ T.readFile "test/testdata/format/Format.fourmolu.formatted.hs" + formattedOrmoluPostFourmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu_post_fourmolu.formatted.hs" doc <- openDoc "Format.hs" "haskell" @@ -46,13 +45,13 @@ formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) documentContents doc >>= liftIO . (@?= formattedOrmolu) - setHlsConfig (formatLspConfig "floskell") - formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - documentContents doc >>= liftIO . (@?= formattedFloskell) + setHlsConfig (formatLspConfig "fourmolu") + formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing) + documentContents doc >>= liftIO . (@?= formattedFourmolu) setHlsConfig (formatLspConfig "ormolu") formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) - documentContents doc >>= liftIO . (@?= formattedOrmoluPostFloskell) + documentContents doc >>= liftIO . (@?= formattedOrmoluPostFourmolu) ] formatLspConfig :: T.Text -> Config diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -13,6 +13,7 @@ import Data.List (delete) import Data.Maybe (fromJust) import Data.Text (Text, pack) +import GHC.Stack (withFrozenCallStack) import Ide.Types import Language.LSP.Protocol.Capabilities import qualified Language.LSP.Protocol.Lens as L @@ -29,7 +30,11 @@ runSession hlsLspCommand progressCaps "test/testdata/diagnostics" $ do let path = "Foo.hs" _ <- openDoc path "haskell" - expectProgressMessages [pack ("Setting up diagnostics (for " ++ path ++ ")"), "Processing", "Indexing"] [] [] + expectProgressMessages + ["Processing"] + [pack ("Setting up diagnostics (for " ++ path ++ ")"), "Indexing"] + [] + [] , requiresEvalPlugin $ testCase "eval plugin sends progress reports" $ runSession hlsLspCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do doc <- openDoc "TIO.hs" "haskell" @@ -37,7 +42,8 @@ (codeLensResponse, createdProgressTokens, activeProgressTokens) <- expectProgressMessagesTill (responseForId SMethod_TextDocumentCodeLens lspId) - ["Setting up testdata (for TIO.hs)", "Processing"] + ["Setting up testdata (for TIO.hs)"] + ["Processing", "Indexing"] [] [] @@ -53,24 +59,24 @@ (command ^. L.command) (decode $ encode $ fromJust $ command ^. L.arguments) - expectProgressMessages ["Evaluating"] createdProgressTokens activeProgressTokens + expectProgressMessages ["Evaluating"] ["Processing", "Indexing"] createdProgressTokens activeProgressTokens _ -> error $ "Unexpected response result: " ++ show response , requiresOrmoluPlugin $ testCase "ormolu plugin sends progress notifications" $ do runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps "test/testdata/format" $ do void configurationRequest setHlsConfig (formatLspConfig "ormolu") doc <- openDoc "Format.hs" "haskell" - expectProgressMessages ["Setting up format (for Format.hs)", "Processing", "Indexing"] [] [] + expectProgressMessages ["Setting up format (for Format.hs)"] ["Processing", "Indexing"] [] [] _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) - expectProgressMessages ["Formatting Format.hs"] [] [] + expectProgressMessages ["Formatting Format.hs"] ["Processing", "Indexing"] [] [] , requiresFourmoluPlugin $ testCase "fourmolu plugin sends progress notifications" $ do runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps "test/testdata/format" $ do void configurationRequest setHlsConfig (formatLspConfig "fourmolu") doc <- openDoc "Format.hs" "haskell" - expectProgressMessages ["Setting up format (for Format.hs)", "Processing", "Indexing"] [] [] + expectProgressMessages ["Setting up format (for Format.hs)"] ["Processing", "Indexing"] [] [] _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) - expectProgressMessages ["Formatting Format.hs"] [] [] + expectProgressMessages ["Formatting Format.hs"] ["Processing", "Indexing"] [] [] ] formatLspConfig :: Text -> Config @@ -114,58 +120,82 @@ interestingMessage theMessage = fmap InterestingMessage theMessage <|> fmap ProgressMessage progressMessage -expectProgressMessagesTill :: Session a -> [Text] -> [ProgressToken] -> [ProgressToken] -> Session (a, [ProgressToken], [ProgressToken]) -expectProgressMessagesTill stopMessage expectedTitles createdProgressTokens activeProgressTokens = do +expectProgressMessagesTill :: HasCallStack => Session a -> [Text] -> [Text] -> [ProgressToken] -> [ProgressToken] -> Session (a, [ProgressToken], [ProgressToken]) +expectProgressMessagesTill stopMessage requiredTitles optionalTitles createdProgressTokens activeProgressTokens = do message <- skipManyTill anyMessage (interestingMessage stopMessage) - case message of - InterestingMessage a -> do - liftIO $ null expectedTitles @? "Expected titles not empty " <> show expectedTitles - pure (a, createdProgressTokens, activeProgressTokens) - ProgressMessage progressMessage -> - updateExpectProgressStateAndRecurseWith - (expectProgressMessagesTill stopMessage) - progressMessage - expectedTitles - createdProgressTokens - activeProgressTokens + withFrozenCallStack $ do + case message of + InterestingMessage a -> do + liftIO $ null requiredTitles @? "Required progress titles were not seen (consider moving to the optional list): " <> show requiredTitles + pure (a, createdProgressTokens, activeProgressTokens) + ProgressMessage progressMessage -> + updateExpectProgressStateAndRecurseWith + (expectProgressMessagesTill stopMessage) + progressMessage + requiredTitles + optionalTitles + createdProgressTokens + activeProgressTokens {- | Test that the server is correctly producing a sequence of progress related - messages. Creates can be dangling, but should be paired with a corresponding begin and end, - optionally with some progress in between. Tokens must match. The begin - messages have titles describing the work that is in-progress, we check that - the titles we see are those we expect. + messages. `create` can be dangling, but `begin` cannot. Each `begin` should + have a respective `end`, optionally with some progress in between. Tokens must + match between these requests. The `begin` messages have titles describing the + work that is in-progress. + + 'requiredTitles' must all be consumed before the loop terminates. + 'optionalTitles' may appear (and if they do, their titles must match), but + their absence is not an error. The LSP spec permits a server to create a + progress token and then abandon it without ever sending a `begin` notification + (e.g. when the underlying work completes before the progress-reporting thread + starts). Any `begin` title that is neither required nor optional is treated as + unexpected and fails the test. + + The loop terminates when all required titles have been seen and all active progress + sessions have ended. -} -expectProgressMessages :: [Text] -> [ProgressToken] -> [ProgressToken] -> Session () -expectProgressMessages [] _ [] = pure () -expectProgressMessages expectedTitles createdProgressTokens activeProgressTokens = do +expectProgressMessages :: HasCallStack => [Text] -> [Text] -> [ProgressToken] -> [ProgressToken] -> Session () +expectProgressMessages [] _ _ [] = pure () +expectProgressMessages requiredTitles optionalTitles createdProgressTokens activeProgressTokens = do message <- skipManyTill anyMessage progressMessage - updateExpectProgressStateAndRecurseWith expectProgressMessages message expectedTitles createdProgressTokens activeProgressTokens + withFrozenCallStack $ + updateExpectProgressStateAndRecurseWith expectProgressMessages message requiredTitles optionalTitles createdProgressTokens activeProgressTokens -updateExpectProgressStateAndRecurseWith :: ([Text] -> [ProgressToken] -> [ProgressToken] -> Session a) +updateExpectProgressStateAndRecurseWith :: HasCallStack + => ([Text] -> [Text] -> [ProgressToken] -> [ProgressToken] -> Session a) -> ProgressMessage -> [Text] + -> [Text] -> [ProgressToken] -> [ProgressToken] -> Session a -updateExpectProgressStateAndRecurseWith f progressMessage expectedTitles createdProgressTokens activeProgressTokens = do +updateExpectProgressStateAndRecurseWith f progressMessage requiredTitles optionalTitles createdProgressTokens activeProgressTokens = do case progressMessage of ProgressCreate params -> do - f expectedTitles ((params ^. L.token): createdProgressTokens) activeProgressTokens + f requiredTitles optionalTitles ((params ^. L.token): createdProgressTokens) activeProgressTokens ProgressBegin token params -> do liftIO $ token `expectedIn` createdProgressTokens - f (delete (params ^. L.title) expectedTitles) (delete token createdProgressTokens) (token:activeProgressTokens) + let title = params ^. L.title + (requiredTitles', optionalTitles') + | title `elem` requiredTitles = (delete title requiredTitles, optionalTitles) + -- Note that we do not delete from the optional titles list. + | title `elem` optionalTitles = (requiredTitles, optionalTitles) + | otherwise = error $ "Unexpected progress title: " ++ show title + ++ "\n required: " ++ show requiredTitles + ++ "\n optional: " ++ show optionalTitles + f requiredTitles' optionalTitles' (delete token createdProgressTokens) (token:activeProgressTokens) ProgressReport token _ -> do liftIO $ token `expectedIn` activeProgressTokens - f expectedTitles createdProgressTokens activeProgressTokens + f requiredTitles optionalTitles createdProgressTokens activeProgressTokens ProgressEnd token _ -> do liftIO $ token `expectedIn` activeProgressTokens - f expectedTitles createdProgressTokens (delete token activeProgressTokens) + f requiredTitles optionalTitles createdProgressTokens (delete token activeProgressTokens) -expectedIn :: (Foldable t, Eq a, Show a) => a -> t a -> Assertion +expectedIn :: (Foldable t, Eq a, Show a, HasCallStack) => a -> t a -> Assertion expectedIn a as = a `elem` as @? "Unexpected " ++ show a -getMessageResult :: Show (ErrorData m) => TResponseMessage m -> MessageResult m +getMessageResult :: (Show (ErrorData m), HasCallStack) => TResponseMessage m -> MessageResult m getMessageResult rsp = case rsp ^. L.result of Right x -> x diff --git a/test/testdata/format/Format.floskell.formatted.hs b/test/testdata/format/Format.floskell.formatted.hs deleted file mode 100644 --- a/test/testdata/format/Format.floskell.formatted.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Format where - -import Data.Int -import Data.List -import Prelude - -foo :: Int -> Int -foo 3 = 2 -foo x = x - -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz { a :: Int, b :: String } diff --git a/test/testdata/format/Format.fourmolu.formatted.hs b/test/testdata/format/Format.fourmolu.formatted.hs new file mode 100644 --- /dev/null +++ b/test/testdata/format/Format.fourmolu.formatted.hs @@ -0,0 +1,16 @@ +module Format where + +import Data.Int +import Data.List +import Prelude + +foo :: Int -> Int +foo 3 = 2 +foo x = x + +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz {a :: Int, b :: String} diff --git a/test/testdata/format/Format.ormolu_post_floskell.formatted.hs b/test/testdata/format/Format.ormolu_post_floskell.formatted.hs deleted file mode 100644 --- a/test/testdata/format/Format.ormolu_post_floskell.formatted.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Format where - -import Data.Int -import Data.List -import Prelude - -foo :: Int -> Int -foo 3 = 2 -foo x = x - -bar :: String -> IO String -bar s = do - x <- return "hello" - return "asdf" - -data Baz = Baz {a :: Int, b :: String} diff --git a/test/testdata/format/Format.ormolu_post_fourmolu.formatted.hs b/test/testdata/format/Format.ormolu_post_fourmolu.formatted.hs new file mode 100644 --- /dev/null +++ b/test/testdata/format/Format.ormolu_post_fourmolu.formatted.hs @@ -0,0 +1,16 @@ +module Format where + +import Data.Int +import Data.List +import Prelude + +foo :: Int -> Int +foo 3 = 2 +foo x = x + +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz {a :: Int, b :: String} diff --git a/test/testdata/hieBiosMainIs/dist-newstyle/cache/plan.json b/test/testdata/hieBiosMainIs/dist-newstyle/cache/plan.json new file mode 100644 --- /dev/null +++ b/test/testdata/hieBiosMainIs/dist-newstyle/cache/plan.json @@ -0,0 +1,1 @@ +{"cabal-version":"3.10.2.0","cabal-lib-version":"3.10.2.1","compiler-id":"ghc-9.8.1","os":"linux","arch":"x86_64","install-plan":[{"type":"pre-existing","id":"base-4.19.0.0-c1f2","pkg-name":"base","pkg-version":"4.19.0.0","depends":["ghc-bignum-1.3-d2d5","ghc-prim-0.11.0-b1d6","rts-1.0.2"]},{"type":"pre-existing","id":"ghc-bignum-1.3-d2d5","pkg-name":"ghc-bignum","pkg-version":"1.3","depends":["ghc-prim-0.11.0-b1d6"]},{"type":"pre-existing","id":"ghc-prim-0.11.0-b1d6","pkg-name":"ghc-prim","pkg-version":"0.11.0","depends":["rts-1.0.2"]},{"type":"configured","id":"hieBiosMainIs-0.1.0.0-inplace-hieBiosMainIs","pkg-name":"hieBiosMainIs","pkg-version":"0.1.0.0","flags":{},"style":"local","pkg-src":{"type":"local","path":"/home/zubin/haskell-language-server/test/testdata/hieBiosMainIs/."},"dist-dir":"/home/zubin/haskell-language-server/test/testdata/hieBiosMainIs/dist-newstyle/build/x86_64-linux/ghc-9.8.1/hieBiosMainIs-0.1.0.0/x/hieBiosMainIs","build-info":"/home/zubin/haskell-language-server/test/testdata/hieBiosMainIs/dist-newstyle/build/x86_64-linux/ghc-9.8.1/hieBiosMainIs-0.1.0.0/x/hieBiosMainIs/build-info.json","depends":["base-4.19.0.0-c1f2"],"exe-depends":[],"component-name":"exe:hieBiosMainIs","bin-file":"/home/zubin/haskell-language-server/test/testdata/hieBiosMainIs/dist-newstyle/build/x86_64-linux/ghc-9.8.1/hieBiosMainIs-0.1.0.0/x/hieBiosMainIs/build/hieBiosMainIs/hieBiosMainIs"},{"type":"pre-existing","id":"rts-1.0.2","pkg-name":"rts","pkg-version":"1.0.2","depends":[]}]} diff --git a/test/testdata/missingModuleTest/missingModule/dist-newstyle/cache/plan.json b/test/testdata/missingModuleTest/missingModule/dist-newstyle/cache/plan.json new file mode 100644 --- /dev/null +++ b/test/testdata/missingModuleTest/missingModule/dist-newstyle/cache/plan.json @@ -0,0 +1,1 @@ +{"cabal-version":"3.10.2.0","cabal-lib-version":"3.10.2.1","compiler-id":"ghc-9.8.1","os":"linux","arch":"x86_64","install-plan":[{"type":"pre-existing","id":"base-4.19.0.0-c1f2","pkg-name":"base","pkg-version":"4.19.0.0","depends":["ghc-bignum-1.3-d2d5","ghc-prim-0.11.0-b1d6","rts-1.0.2"]},{"type":"pre-existing","id":"ghc-bignum-1.3-d2d5","pkg-name":"ghc-bignum","pkg-version":"1.3","depends":["ghc-prim-0.11.0-b1d6"]},{"type":"pre-existing","id":"ghc-prim-0.11.0-b1d6","pkg-name":"ghc-prim","pkg-version":"0.11.0","depends":["rts-1.0.2"]},{"type":"configured","id":"missingModule-0.1.0.0-inplace","pkg-name":"missingModule","pkg-version":"0.1.0.0","flags":{},"style":"local","pkg-src":{"type":"local","path":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/missingModule/."},"dist-dir":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/missingModule/dist-newstyle/build/x86_64-linux/ghc-9.8.1/missingModule-0.1.0.0","build-info":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/missingModule/dist-newstyle/build/x86_64-linux/ghc-9.8.1/missingModule-0.1.0.0/build-info.json","depends":["base-4.19.0.0-c1f2"],"exe-depends":[],"component-name":"lib"},{"type":"pre-existing","id":"rts-1.0.2","pkg-name":"rts","pkg-version":"1.0.2","depends":[]}]} diff --git a/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/cache/plan.json b/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/cache/plan.json new file mode 100644 --- /dev/null +++ b/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/cache/plan.json @@ -0,0 +1,1 @@ +{"cabal-version":"3.10.2.0","cabal-lib-version":"3.10.2.1","compiler-id":"ghc-9.8.1","os":"linux","arch":"x86_64","install-plan":[{"type":"pre-existing","id":"base-4.19.0.0-c1f2","pkg-name":"base","pkg-version":"4.19.0.0","depends":["ghc-bignum-1.3-d2d5","ghc-prim-0.11.0-b1d6","rts-1.0.2"]},{"type":"pre-existing","id":"ghc-bignum-1.3-d2d5","pkg-name":"ghc-bignum","pkg-version":"1.3","depends":["ghc-prim-0.11.0-b1d6"]},{"type":"pre-existing","id":"ghc-prim-0.11.0-b1d6","pkg-name":"ghc-prim","pkg-version":"0.11.0","depends":["rts-1.0.2"]},{"type":"configured","id":"noPrefixMatch-0.1.0.0-inplace-testExe","pkg-name":"noPrefixMatch","pkg-version":"0.1.0.0","flags":{},"style":"local","pkg-src":{"type":"local","path":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/noPrefixMatch/."},"dist-dir":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/build/x86_64-linux/ghc-9.8.1/noPrefixMatch-0.1.0.0/x/testExe","build-info":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/build/x86_64-linux/ghc-9.8.1/noPrefixMatch-0.1.0.0/x/testExe/build-info.json","depends":["base-4.19.0.0-c1f2"],"exe-depends":[],"component-name":"exe:testExe","bin-file":"/home/zubin/haskell-language-server/test/testdata/missingModuleTest/noPrefixMatch/dist-newstyle/build/x86_64-linux/ghc-9.8.1/noPrefixMatch-0.1.0.0/x/testExe/build/testExe/testExe"},{"type":"pre-existing","id":"rts-1.0.2","pkg-name":"rts","pkg-version":"1.0.2","depends":[]}]} diff --git a/test/testdata/schema/ghc910/default-config.golden.json b/test/testdata/schema/ghc910/default-config.golden.json --- a/test/testdata/schema/ghc910/default-config.golden.json +++ b/test/testdata/schema/ghc910/default-config.golden.json @@ -96,8 +96,9 @@ "codeLensOn": true, "inlayHintsOn": true }, - "moduleName": { - "globalOn": true + "notes": { + "completionOn": true, + "hoverOn": true }, "ormolu": { "config": { @@ -120,10 +121,11 @@ "globalOn": true }, "rename": { + "codeLensOn": true, "config": { - "crossModule": false + "crossModule": true }, - "globalOn": true + "renameOn": true }, "semanticTokens": { "config": { diff --git a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json --- a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json @@ -231,12 +231,18 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.moduleName.globalOn": { + "haskell.plugin.notes.completionOn": { "default": true, - "description": "Enables moduleName plugin", + "description": "Enables notes completions", "scope": "resource", "type": "boolean" }, + "haskell.plugin.notes.hoverOn": { + "default": true, + "description": "Enables notes hover", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.ormolu.config.external": { "default": false, "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", @@ -273,15 +279,21 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.codeLensOn": { + "default": true, + "description": "Enables rename code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.rename.config.crossModule": { - "default": false, + "default": true, "markdownDescription": "Enable experimental cross-module renaming", "scope": "resource", "type": "boolean" }, - "haskell.plugin.rename.globalOn": { + "haskell.plugin.rename.renameOn": { "default": true, - "description": "Enables rename plugin", + "description": "Enables rename rename", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc912/default-config.golden.json b/test/testdata/schema/ghc912/default-config.golden.json --- a/test/testdata/schema/ghc912/default-config.golden.json +++ b/test/testdata/schema/ghc912/default-config.golden.json @@ -103,8 +103,9 @@ "codeLensOn": true, "inlayHintsOn": true }, - "moduleName": { - "globalOn": true + "notes": { + "completionOn": true, + "hoverOn": true }, "ormolu": { "config": { @@ -127,10 +128,11 @@ "globalOn": true }, "rename": { + "codeLensOn": true, "config": { - "crossModule": false + "crossModule": true }, - "globalOn": true + "renameOn": true }, "semanticTokens": { "config": { diff --git a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json --- a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json @@ -249,12 +249,18 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.moduleName.globalOn": { + "haskell.plugin.notes.completionOn": { "default": true, - "description": "Enables moduleName plugin", + "description": "Enables notes completions", "scope": "resource", "type": "boolean" }, + "haskell.plugin.notes.hoverOn": { + "default": true, + "description": "Enables notes hover", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.ormolu.config.external": { "default": false, "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", @@ -291,15 +297,21 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.codeLensOn": { + "default": true, + "description": "Enables rename code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.rename.config.crossModule": { - "default": false, + "default": true, "markdownDescription": "Enable experimental cross-module renaming", "scope": "resource", "type": "boolean" }, - "haskell.plugin.rename.globalOn": { + "haskell.plugin.rename.renameOn": { "default": true, - "description": "Enables rename plugin", + "description": "Enables rename rename", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc914/default-config.golden.json b/test/testdata/schema/ghc914/default-config.golden.json --- a/test/testdata/schema/ghc914/default-config.golden.json +++ b/test/testdata/schema/ghc914/default-config.golden.json @@ -90,8 +90,9 @@ "codeLensOn": true, "inlayHintsOn": true }, - "moduleName": { - "globalOn": true + "notes": { + "completionOn": true, + "hoverOn": true }, "overloaded-record-dot": { "globalOn": true @@ -109,10 +110,11 @@ "globalOn": true }, "rename": { + "codeLensOn": true, "config": { - "crossModule": false + "crossModule": true }, - "globalOn": true + "renameOn": true }, "semanticTokens": { "config": { diff --git a/test/testdata/schema/ghc914/vscode-extension-schema.golden.json b/test/testdata/schema/ghc914/vscode-extension-schema.golden.json --- a/test/testdata/schema/ghc914/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc914/vscode-extension-schema.golden.json @@ -219,12 +219,18 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.moduleName.globalOn": { + "haskell.plugin.notes.completionOn": { "default": true, - "description": "Enables moduleName plugin", + "description": "Enables notes completions", "scope": "resource", "type": "boolean" }, + "haskell.plugin.notes.hoverOn": { + "default": true, + "description": "Enables notes hover", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.overloaded-record-dot.globalOn": { "default": true, "description": "Enables overloaded-record-dot plugin", @@ -255,15 +261,21 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.codeLensOn": { + "default": true, + "description": "Enables rename code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.rename.config.crossModule": { - "default": false, + "default": true, "markdownDescription": "Enable experimental cross-module renaming", "scope": "resource", "type": "boolean" }, - "haskell.plugin.rename.globalOn": { + "haskell.plugin.rename.renameOn": { "default": true, - "description": "Enables rename plugin", + "description": "Enables rename rename", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -103,8 +103,9 @@ "codeLensOn": true, "inlayHintsOn": true }, - "moduleName": { - "globalOn": true + "notes": { + "completionOn": true, + "hoverOn": true }, "ormolu": { "config": { @@ -127,10 +128,11 @@ "globalOn": true }, "rename": { + "codeLensOn": true, "config": { - "crossModule": false + "crossModule": true }, - "globalOn": true + "renameOn": true }, "retrie": { "globalOn": true diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -249,12 +249,18 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.moduleName.globalOn": { + "haskell.plugin.notes.completionOn": { "default": true, - "description": "Enables moduleName plugin", + "description": "Enables notes completions", "scope": "resource", "type": "boolean" }, + "haskell.plugin.notes.hoverOn": { + "default": true, + "description": "Enables notes hover", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.ormolu.config.external": { "default": false, "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", @@ -291,15 +297,21 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.codeLensOn": { + "default": true, + "description": "Enables rename code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.rename.config.crossModule": { - "default": false, + "default": true, "markdownDescription": "Enable experimental cross-module renaming", "scope": "resource", "type": "boolean" }, - "haskell.plugin.rename.globalOn": { + "haskell.plugin.rename.renameOn": { "default": true, - "description": "Enables rename plugin", + "description": "Enables rename rename", "scope": "resource", "type": "boolean" }, diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -103,8 +103,9 @@ "codeLensOn": true, "inlayHintsOn": true }, - "moduleName": { - "globalOn": true + "notes": { + "completionOn": true, + "hoverOn": true }, "ormolu": { "config": { @@ -127,10 +128,11 @@ "globalOn": true }, "rename": { + "codeLensOn": true, "config": { - "crossModule": false + "crossModule": true }, - "globalOn": true + "renameOn": true }, "retrie": { "globalOn": true diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -249,12 +249,18 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.moduleName.globalOn": { + "haskell.plugin.notes.completionOn": { "default": true, - "description": "Enables moduleName plugin", + "description": "Enables notes completions", "scope": "resource", "type": "boolean" }, + "haskell.plugin.notes.hoverOn": { + "default": true, + "description": "Enables notes hover", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.ormolu.config.external": { "default": false, "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", @@ -291,15 +297,21 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.codeLensOn": { + "default": true, + "description": "Enables rename code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.rename.config.crossModule": { - "default": false, + "default": true, "markdownDescription": "Enable experimental cross-module renaming", "scope": "resource", "type": "boolean" }, - "haskell.plugin.rename.globalOn": { + "haskell.plugin.rename.renameOn": { "default": true, - "description": "Enables rename plugin", + "description": "Enables rename rename", "scope": "resource", "type": "boolean" }, diff --git a/test/utils/Test/Hls/Flags.hs b/test/utils/Test/Hls/Flags.hs --- a/test/utils/Test/Hls/Flags.hs +++ b/test/utils/Test/Hls/Flags.hs @@ -17,14 +17,6 @@ #endif -- * Formatters --- | Disable test unless the floskell flag is set -requiresFloskellPlugin :: TestTree -> TestTree -#if hls_floskell -requiresFloskellPlugin = id -#else -requiresFloskellPlugin = ignoreTestBecause "Floskell plugin disabled" -#endif - -- | Disable test unless the fourmolu flag is set requiresFourmoluPlugin :: TestTree -> TestTree #if hls_fourmolu