haskell-language-server 1.6.1.1 → 1.7.0.0
raw patch · 13 files changed
+803/−401 lines, 13 filesdep +hls-change-type-signature-plugindep +prettyprinterdep +unixdep −hsloggerdep ~ghcidedep ~githashdep ~hls-alternate-number-format-pluginnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: hls-change-type-signature-plugin, prettyprinter, unix
Dependencies removed: hslogger
Dependency ranges changed: ghcide, githash, hls-alternate-number-format-plugin, hls-brittany-plugin, hls-call-hierarchy-plugin, hls-class-plugin, hls-eval-plugin, hls-explicit-imports-plugin, hls-floskell-plugin, hls-fourmolu-plugin, hls-haddock-comments-plugin, hls-hlint-plugin, hls-module-name-plugin, hls-ormolu-plugin, hls-plugin-api, hls-pragmas-plugin, hls-qualify-imported-names-plugin, hls-refine-imports-plugin, hls-rename-plugin, hls-retrie-plugin, hls-selection-range-plugin, hls-stylish-haskell-plugin, hls-test-utils
API changes (from Hackage documentation)
+ Ide.Arguments: PrintLibDir :: Arguments
+ Ide.Main: LogDirectory :: !FilePath -> Log
+ Ide.Main: LogIDEMain :: Log -> Log
+ Ide.Main: LogLspStart :: !GhcideArguments -> ![PluginId] -> Log
+ Ide.Main: LogOther :: Text -> Log
+ Ide.Main: LogVersion :: !String -> Log
+ Ide.Main: data Log
+ Ide.Main: instance GHC.Show.Show Ide.Main.Log
+ Ide.Main: instance Prettyprinter.Internal.Pretty Ide.Main.Log
- Ide.Main: defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
+ Ide.Main: defaultMain :: Recorder (WithPriority Log) -> Arguments -> IdePlugins IdeState -> IO ()
- Ide.Main: runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()
+ Ide.Main: runLspMode :: Recorder (WithPriority Log) -> GhcideArguments -> IdePlugins IdeState -> IO ()
Files
- ChangeLog.md +178/−0
- exe/Main.hs +77/−11
- exe/Plugins.hs +52/−36
- exe/Wrapper.hs +45/−12
- haskell-language-server.cabal +41/−27
- plugins/default/src/Ide/Plugin/Example.hs +15/−6
- plugins/default/src/Ide/Plugin/Example2.hs +16/−7
- src/Ide/Arguments.hs +154/−151
- src/Ide/Main.hs +57/−39
- src/Ide/Version.hs +82/−82
- test/functional/Completion.hs +28/−25
- test/functional/FunctionalCodeAction.hs +8/−5
- test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs +50/−0
ChangeLog.md view
@@ -1,5 +1,181 @@ # Changelog for haskell-language-server +## 1.7.0.0++- Distribute dynamically linked binaries for HLS to avoid statically linking against GLIBC+ and system libraries, and to avoid unpredictable failures due to subtle differences+ between the GHC used to compile HLS and the GHC installed on the users machine+ (@hasufell, #2675, #2431)++- Improved recompilation avoidance in projects that make use of Template Haskell (#2316). See+ the [blog post](https://well-typed.com/blog/2022/04/hls-performance/) for more details.+ This release includes the `avoid-recompile` set of commits described in the blog post.++- Support for GHC 9.2.2++- Removal of HLS installer scripts as mentioned by the deprecation notice last release (#2773)++- Many more improvements and bug fixed thanks to our contributors!++### Pull requests merged for 1.6.1.1++- Restore concise type variables in ghc-9.2+([#2828](https://github.com/haskell/haskell-language-server/pull/2828)) by @July541+- Should no related code lens if the module name is correct+([#2826](https://github.com/haskell/haskell-language-server/pull/2826)) by @July541+- Bump cachix/install-nix-action from 16 to 17+([#2823](https://github.com/haskell/haskell-language-server/pull/2823)) by @dependabot[bot]+- Bump actions/upload-artifact from 2 to 3+([#2822](https://github.com/haskell/haskell-language-server/pull/2822)) by @dependabot[bot]+- Bump actions/download-artifact from 2 to 3+([#2821](https://github.com/haskell/haskell-language-server/pull/2821)) by @dependabot[bot]+- bench: Add more metrics+([#2814](https://github.com/haskell/haskell-language-server/pull/2814)) by @wz1000+- Enable rename plugin+([#2809](https://github.com/haskell/haskell-language-server/pull/2809)) by @OliverMadine+- Fix `cabal install` commands for local HLS build in docs+([#2807](https://github.com/haskell/haskell-language-server/pull/2807)) by @9999years+- Bump actions/cache from 2 to 3+([#2806](https://github.com/haskell/haskell-language-server/pull/2806)) by @dependabot[bot]+- [hls-graph] Optimise waitConcurrently+([#2805](https://github.com/haskell/haskell-language-server/pull/2805)) by @pepeiborra+- [bench] track changes to hls-* projects+([#2803](https://github.com/haskell/haskell-language-server/pull/2803)) by @pepeiborra+- Fix Show instance+([#2802](https://github.com/haskell/haskell-language-server/pull/2802)) by @pepeiborra+- Provide all format suggestions in AlternatFormat Code Action+([#2790](https://github.com/haskell/haskell-language-server/pull/2790)) by @drsooch+- Avoid race conditions with VFS and VFS versions+([#2789](https://github.com/haskell/haskell-language-server/pull/2789)) by @wz1000+- Don't show the redundant space+([#2788](https://github.com/haskell/haskell-language-server/pull/2788)) by @July541+- Target GHC 9.2.2+([#2787](https://github.com/haskell/haskell-language-server/pull/2787)) by @pepeiborra+- Allow import all constructors+([#2782](https://github.com/haskell/haskell-language-server/pull/2782)) by @July541+- Customizable TH warning+([#2781](https://github.com/haskell/haskell-language-server/pull/2781)) by @pepeiborra+- Fix #2693+([#2780](https://github.com/haskell/haskell-language-server/pull/2780)) by @wz1000+- Add Gentoo installation details+([#2778](https://github.com/haskell/haskell-language-server/pull/2778)) by @paul-jewell+- Eval plugin: mark exceptions+([#2775](https://github.com/haskell/haskell-language-server/pull/2775)) by @xsebek+- Fix 2 space leaks+([#2774](https://github.com/haskell/haskell-language-server/pull/2774)) by @pepeiborra+- Delete HLS installer scripts+([#2773](https://github.com/haskell/haskell-language-server/pull/2773)) by @fendor+- Purge some more hslogger+([#2770](https://github.com/haskell/haskell-language-server/pull/2770)) by @michaelpj+- Abbreviate explicit import code lenses+([#2769](https://github.com/haskell/haskell-language-server/pull/2769)) by @michaelpj+- Review masking and add traces when things don't cancel timely+([#2768](https://github.com/haskell/haskell-language-server/pull/2768)) by @pepeiborra+- Upgrade to hie-bios 0.9.1+([#2766](https://github.com/haskell/haskell-language-server/pull/2766)) by @fendor+- Avoid extra parens for wildcard type signature+([#2764](https://github.com/haskell/haskell-language-server/pull/2764)) by @xsebek+- Add an option to run Fourmolu via the CLI interface of a separate binary, rather than the bundled library+([#2763](https://github.com/haskell/haskell-language-server/pull/2763)) by @georgefst+- Fix Change Type Signature Plugin test suite for 9.2.1+([#2761](https://github.com/haskell/haskell-language-server/pull/2761)) by @drsooch+- Bump actions/checkout from 2 to 3+([#2759](https://github.com/haskell/haskell-language-server/pull/2759)) by @dependabot[bot]+- Refactor LSP logger and log via window/logMessage also+([#2758](https://github.com/haskell/haskell-language-server/pull/2758)) by @michaelpj+- Fix the tower of Babel+([#2757](https://github.com/haskell/haskell-language-server/pull/2757)) by @hasufell+- Implement cycle detection in hls-graph+([#2756](https://github.com/haskell/haskell-language-server/pull/2756)) by @pepeiborra+- Adjust rendering of error logs and drop unneeded MonadUnliftIO instance+([#2755](https://github.com/haskell/haskell-language-server/pull/2755)) by @pepeiborra+- Estimate file versions safely+([#2753](https://github.com/haskell/haskell-language-server/pull/2753)) by @pepeiborra+- Fix test failure for AlternateNumberFormat+([#2752](https://github.com/haskell/haskell-language-server/pull/2752)) by @drsooch+- LSP window message log recorder+([#2750](https://github.com/haskell/haskell-language-server/pull/2750)) by @pepeiborra+- Fix FreeBSD bindist build+([#2748](https://github.com/haskell/haskell-language-server/pull/2748)) by @hasufell+- Improve bindist makefile+([#2746](https://github.com/haskell/haskell-language-server/pull/2746)) by @hasufell+- Fix flake.lock+([#2743](https://github.com/haskell/haskell-language-server/pull/2743)) by @michaelpj+- Add failing test for variables in hovers+([#2742](https://github.com/haskell/haskell-language-server/pull/2742)) by @michaelpj+- Update Define Function Code Action to have knowledge of comments+([#2740](https://github.com/haskell/haskell-language-server/pull/2740)) by @drsooch+- Upgrade to hie-bios 0.9.0+([#2738](https://github.com/haskell/haskell-language-server/pull/2738)) by @fendor+- Track file versions accurately.+([#2735](https://github.com/haskell/haskell-language-server/pull/2735)) by @wz1000+- Fix hls-class-plugin on ghc-9.2+([#2733](https://github.com/haskell/haskell-language-server/pull/2733)) by @July541+- Bump actions/github-script from 2 to 6+([#2730](https://github.com/haskell/haskell-language-server/pull/2730)) by @dependabot[bot]+- Delete the Telemetry log level+([#2727](https://github.com/haskell/haskell-language-server/pull/2727)) by @michaelpj+- Tone down logging of plugin rules+([#2723](https://github.com/haskell/haskell-language-server/pull/2723)) by @pepeiborra+- Troubleshooting: GHC 9.2 partial support+([#2722](https://github.com/haskell/haskell-language-server/pull/2722)) by @andys8+- Remove `getHspecFormattedConfig` which is no longer used+([#2721](https://github.com/haskell/haskell-language-server/pull/2721)) by @hololeap+- Fix crash for non-LSP modes wrt #2627+([#2719](https://github.com/haskell/haskell-language-server/pull/2719)) by @hasufell+- Wingman: Don't use keywords for variable names+([#2717](https://github.com/haskell/haskell-language-server/pull/2717)) by @isovector+- Expose DisplayTHWarning (backport #2712)+([#2714](https://github.com/haskell/haskell-language-server/pull/2714)) by @mergify[bot]+- Send LSP error when GHC cannot be found+([#2713](https://github.com/haskell/haskell-language-server/pull/2713)) by @hasufell+- Expose DisplayTHWarning+([#2712](https://github.com/haskell/haskell-language-server/pull/2712)) by @pepeiborra+- Improve wrapper cradle errors+([#2711](https://github.com/haskell/haskell-language-server/pull/2711)) by @hasufell+- Fix min bound for ghc-exactprint dependency in hls-class-plugin+([#2710](https://github.com/haskell/haskell-language-server/pull/2710)) by @pepeiborra+- Remove duplicate help messages & format CRLF to LF+([#2709](https://github.com/haskell/haskell-language-server/pull/2709)) by @July541+- Add @July541 for call-hierarchy-plugin+([#2708](https://github.com/haskell/haskell-language-server/pull/2708)) by @July541+- Fix releasing+([#2707](https://github.com/haskell/haskell-language-server/pull/2707)) by @hasufell+- Print info message when ignoring a file due to a none cradle+([#2701](https://github.com/haskell/haskell-language-server/pull/2701)) by @ThomasCrevoisier+- fix: handle comma in extend import list with ghc 9.2+([#2697](https://github.com/haskell/haskell-language-server/pull/2697)) by @guibou+- Build Alternate Number Format Plugin with GHC 9.2+([#2696](https://github.com/haskell/haskell-language-server/pull/2696)) by @drsooch+- Optionally publish packages definitely in the hackage workflow+([#2689](https://github.com/haskell/haskell-language-server/pull/2689)) by @jneira+- Set -dynamic in cabal.project+([#2688](https://github.com/haskell/haskell-language-server/pull/2688)) by @jneira+- Multi component issues in GHC 9.2+([#2687](https://github.com/haskell/haskell-language-server/pull/2687)) by @pepeiborra+- Fix flaky boot def test+([#2686](https://github.com/haskell/haskell-language-server/pull/2686)) by @eddiemundo+- Fix typos in troubleshooting.md+([#2680](https://github.com/haskell/haskell-language-server/pull/2680)) by @visortelle+- Add pre-commit hook for cleaning up mixed-line endings+([#2679](https://github.com/haskell/haskell-language-server/pull/2679)) by @drsooch+- Add a test for #2673+([#2676](https://github.com/haskell/haskell-language-server/pull/2676)) by @pepeiborra+- Implement distribution of dynamic builds+([#2675](https://github.com/haskell/haskell-language-server/pull/2675)) by @hasufell+- Restore eval plugin build for GHC 9.2+([#2669](https://github.com/haskell/haskell-language-server/pull/2669)) by @guibou+- Change Type Signature Plugin+([#2660](https://github.com/haskell/haskell-language-server/pull/2660)) by @drsooch+- Nix flake fix dev shells+([#2655](https://github.com/haskell/haskell-language-server/pull/2655)) by @guibou+- Speed up fuzzy search+([#2639](https://github.com/haskell/haskell-language-server/pull/2639)) by @Bodigrim+- Improve logging+([#2558](https://github.com/haskell/haskell-language-server/pull/2558)) by @eddiemundo+- Improve recompilation avoidance in the presence of TH+([#2316](https://github.com/haskell/haskell-language-server/pull/2316)) by @wz1000 + ## 1.6.1.1 (*only hackage release*) - Release to update haskell-language-server.cabal in hackage, setting the build for the executable component as dynamically linked@@ -59,6 +235,8 @@ ### Pull requests merged for 1.6.0 +- Prepare 1.6.0 release+([#2642](https://github.com/haskell/haskell-language-server/pull/2642)) by @jneira - Implement stripPrefix via T.stripPrefix ([#2645](https://github.com/haskell/haskell-language-server/pull/2645)) by @Bodigrim - Change Type Family Export pattern
exe/Main.hs view
@@ -1,21 +1,87 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} module Main(main) where -import Ide.Arguments (Arguments (..), GhcideArguments (..),- getArguments)-import Ide.Main (defaultMain)-import Plugins+import Control.Monad.IO.Class (liftIO)+import Data.Function ((&))+import Data.Text (Text)+import qualified Development.IDE.Types.Logger as Logger+import Development.IDE.Types.Logger (Priority (Debug, Info, Error),+ WithPriority (WithPriority, priority),+ cfilter, cmapWithPrio,+ makeDefaultStderrRecorder,+ withDefaultRecorder, renderStrict, layoutPretty, defaultLayoutOptions, Doc)+import Ide.Arguments (Arguments (..),+ GhcideArguments (..),+ getArguments)+import Ide.Main (defaultMain)+import qualified Ide.Main as IdeMain+import Ide.PluginUtils (pluginDescToIdePlugins)+import Ide.Types (PluginDescriptor (pluginNotificationHandlers), defaultPluginDescriptor, mkPluginNotificationHandler)+import Language.LSP.Server as LSP+import Language.LSP.Types as LSP+import qualified Plugins+import Prettyprinter (Pretty (pretty), vsep) +data Log+ = LogIdeMain IdeMain.Log+ | LogPlugins Plugins.Log++instance Pretty Log where+ pretty log = case log of+ LogIdeMain ideMainLog -> pretty ideMainLog+ LogPlugins pluginsLog -> pretty pluginsLog+ main :: IO () main = do- args <- getArguments "haskell-language-server" (idePlugins False)+ -- plugin cli commands use stderr logger for now unless we change the args+ -- parser to get logging arguments first or do more complicated things+ pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing Info+ args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder) False) - let withExamples =- case args of- Ghcide GhcideArguments{..} -> argsExamplePlugin- _ -> False+ (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder+ (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder+ -- This plugin just installs a handler for the `initialized` notification, which then+ -- picks up the LSP environment and feeds it to our recorders+ let lspRecorderPlugin = (defaultPluginDescriptor "LSPRecorderCallback")+ { pluginNotificationHandlers = mkPluginNotificationHandler LSP.SInitialized $ \_ _ _ _ -> do+ env <- LSP.getLspEnv+ liftIO $ (cb1 <> cb2) env+ } - defaultMain args (idePlugins withExamples)+ let (minPriority, logFilePath, includeExamplePlugins) =+ case args of+ Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile, argsExamplePlugin } ->+ let minPriority = if argsDebugOn || argsTesting then Debug else Info+ in (minPriority, argsLogFile, argsExamplePlugin)+ _ -> (Info, Nothing, False)++ withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do+ let+ recorder = cmapWithPrio pretty $ mconcat+ [textWithPriorityRecorder+ & cfilter (\WithPriority{ priority } -> priority >= minPriority)+ , lspMessageRecorder+ & cfilter (\WithPriority{ priority } -> priority >= Error)+ & cmapWithPrio renderDoc+ , lspLogRecorder+ & cfilter (\WithPriority{ priority } -> priority >= minPriority)+ & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)+ ]+ plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder) includeExamplePlugins)++ defaultMain+ (cmapWithPrio LogIdeMain recorder)+ args+ (plugins <> pluginDescToIdePlugins [lspRecorderPlugin])++renderDoc :: Doc a -> Text+renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vsep+ ["Error condition, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): "+ ,d+ ]++issueTrackerUrl :: Doc a+issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"
exe/Plugins.hs view
@@ -1,103 +1,114 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-} module Plugins where +import Development.IDE.Types.Logger (Pretty (pretty), Recorder,+ WithPriority, cmapWithPrio) import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types (IdePlugins) -- fixed plugins import Development.IDE (IdeState)-import Development.IDE.Plugin.HLS.GhcIde as GhcIde-import Ide.Plugin.Example as Example-import Ide.Plugin.Example2 as Example2+import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde+import qualified Ide.Plugin.Example as Example+import qualified Ide.Plugin.Example2 as Example2 -- haskell-language-server optional plugins #if qualifyImportedNames-import Ide.Plugin.QualifyImportedNames as QualifyImportedNames+import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames #endif #if callHierarchy-import Ide.Plugin.CallHierarchy as CallHierarchy+import qualified Ide.Plugin.CallHierarchy as CallHierarchy #endif #if class-import Ide.Plugin.Class as Class+import qualified Ide.Plugin.Class as Class #endif #if haddockComments-import Ide.Plugin.HaddockComments as HaddockComments+import qualified Ide.Plugin.HaddockComments as HaddockComments #endif #if eval-import Ide.Plugin.Eval as Eval+import qualified Ide.Plugin.Eval as Eval #endif #if importLens-import Ide.Plugin.ExplicitImports as ExplicitImports+import qualified Ide.Plugin.ExplicitImports as ExplicitImports #endif #if refineImports-import Ide.Plugin.RefineImports as RefineImports+import qualified Ide.Plugin.RefineImports as RefineImports #endif #if rename-import Ide.Plugin.Rename as Rename+import qualified Ide.Plugin.Rename as Rename #endif #if retrie-import Ide.Plugin.Retrie as Retrie+import qualified Ide.Plugin.Retrie as Retrie #endif #if tactic-import Ide.Plugin.Tactic as Tactic+import qualified Ide.Plugin.Tactic as Tactic #endif #if hlint-import Ide.Plugin.Hlint as Hlint+import qualified Ide.Plugin.Hlint as Hlint #endif #if moduleName-import Ide.Plugin.ModuleName as ModuleName+import qualified Ide.Plugin.ModuleName as ModuleName #endif #if pragmas-import Ide.Plugin.Pragmas as Pragmas+import qualified Ide.Plugin.Pragmas as Pragmas #endif #if splice-import Ide.Plugin.Splice as Splice+import qualified Ide.Plugin.Splice as Splice #endif #if alternateNumberFormat-import Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat+import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat #endif #if selectionRange import Ide.Plugin.SelectionRange as SelectionRange #endif +#if changeTypeSignature+import Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature+#endif -- formatters #if floskell-import Ide.Plugin.Floskell as Floskell+import qualified Ide.Plugin.Floskell as Floskell #endif #if fourmolu-import Ide.Plugin.Fourmolu as Fourmolu+import qualified Ide.Plugin.Fourmolu as Fourmolu #endif #if ormolu-import Ide.Plugin.Ormolu as Ormolu+import qualified Ide.Plugin.Ormolu as Ormolu #endif #if stylishHaskell-import Ide.Plugin.StylishHaskell as StylishHaskell+import qualified Ide.Plugin.StylishHaskell as StylishHaskell #endif #if brittany-import Ide.Plugin.Brittany as Brittany+import qualified Ide.Plugin.Brittany as Brittany #endif +data Log = forall a. (Pretty a) => Log a++instance Pretty Log where+ pretty (Log a) = pretty a+ -- --------------------------------------------------------------------- -- | The plugins configured for use in this instance of the language@@ -105,9 +116,11 @@ -- These can be freely added or removed to tailor the available -- features of the server. -idePlugins :: Bool -> IdePlugins IdeState-idePlugins includeExamples = pluginDescToIdePlugins allPlugins+idePlugins :: Recorder (WithPriority Log) -> Bool -> IdePlugins IdeState+idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins where+ pluginRecorder :: forall log. (Pretty log) => Recorder (WithPriority log)+ pluginRecorder = cmapWithPrio Log recorder allPlugins = if includeExamples then basePlugins ++ examplePlugins else basePlugins@@ -122,7 +135,7 @@ Fourmolu.descriptor "fourmolu" : #endif #if tactic- Tactic.descriptor "tactics" :+ Tactic.descriptor pluginRecorder "tactics" : #endif #if ormolu Ormolu.descriptor "ormolu" :@@ -149,36 +162,39 @@ HaddockComments.descriptor "haddockComments" : #endif #if eval- Eval.descriptor "eval" :+ Eval.descriptor pluginRecorder "eval" : #endif #if importLens- ExplicitImports.descriptor "importLens" :+ ExplicitImports.descriptor pluginRecorder "importLens" : #endif #if qualifyImportedNames QualifyImportedNames.descriptor "qualifyImportedNames" : #endif #if refineImports- RefineImports.descriptor "refineImports" :+ RefineImports.descriptor pluginRecorder "refineImports" : #endif #if moduleName ModuleName.descriptor "moduleName" : #endif #if hlint- Hlint.descriptor "hlint" :+ Hlint.descriptor pluginRecorder "hlint" : #endif #if splice Splice.descriptor "splice" : #endif #if alternateNumberFormat- AlternateNumberFormat.descriptor "alternateNumberFormat" :+ AlternateNumberFormat.descriptor pluginRecorder "alternateNumberFormat" : #endif #if selectionRange SelectionRange.descriptor "selectionRange" : #endif+#if changeTypeSignature+ ChangeTypeSignature.descriptor "changeTypeSignature" :+#endif -- The ghcide descriptors should come last so that the notification handlers -- (which restart the Shake build) run after everything else- GhcIde.descriptors+ GhcIde.descriptors pluginRecorder examplePlugins =- [Example.descriptor "eg"- ,Example2.descriptor "eg2"+ [Example.descriptor pluginRecorder "eg"+ ,Example2.descriptor pluginRecorder "eg2" ]
exe/Wrapper.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE CPP #-} -- | This module is based on the hie-wrapper.sh script in -- https://github.com/alanz/vscode-hie-server module Main where import Control.Monad.Extra+import Data.Char (isSpace) import Data.Default import Data.Foldable import Data.List@@ -19,7 +22,12 @@ import System.FilePath import System.IO import System.Info+#ifndef mingw32_HOST_OS+import System.Posix.Process (executeFile)+import qualified Data.Map.Strict as Map+#else import System.Process+#endif -- --------------------------------------------------------------------- @@ -45,7 +53,10 @@ BiosMode PrintCradleType -> print =<< findProjectCradle-+ PrintLibDir -> do+ cradle <- findProjectCradle' False+ (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir cradle+ putStr libdir _ -> launchHaskellLanguageServer args launchHaskellLanguageServer :: Arguments -> IO ()@@ -96,11 +107,29 @@ mexes <- traverse findExecutable candidates case asum mexes of- Nothing -> hPutStrLn stderr $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates+ Nothing -> die $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates Just e -> do hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e+#ifdef mingw32_HOST_OS callProcess e args+#else+ let Cradle { cradleOptsProg = CradleAction { runGhcCmd } } = cradle+ -- we need to be compatible with NoImplicitPrelude+ ghcBinary <- (fmap trim <$> runGhcCmd ["-v0", "-package-env=-", "-ignore-dot-ghci", "-e", "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"])+ >>= cradleResult "Failed to get project GHC executable path"+ libdir <- HieBios.getRuntimeGhcLibDir cradle+ >>= cradleResult "Failed to get project GHC libdir path"+ env <- Map.fromList <$> getEnvironment+ let newEnv = Map.insert "GHC_BIN" ghcBinary $ Map.insert "GHC_LIBDIR" libdir env+ executeFile e True args (Just (Map.toList newEnv))+#endif ++cradleResult :: String -> CradleLoadResult a -> IO a+cradleResult _ (CradleSuccess a) = pure a+cradleResult str (CradleFail e) = die $ str ++ ": " ++ show e+cradleResult str CradleNone = die $ str ++ ": no cradle"+ -- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also -- checks to see if the tool is missing if it is one of getRuntimeGhcVersion' :: Show a => Cradle a -> IO String@@ -114,12 +143,7 @@ Direct -> checkToolExists "ghc" _ -> pure () - ghcVersionRes <- HieBios.getRuntimeGhcVersion cradle- case ghcVersionRes of- CradleSuccess ver -> do- return ver- CradleFail error -> die $ "Failed to get project GHC version:" ++ show error- CradleNone -> die "Failed get project GHC version, since we have a none cradle"+ HieBios.getRuntimeGhcVersion cradle >>= cradleResult "Failed to get project GHC version" where checkToolExists exe = do exists <- findExecutable exe@@ -130,15 +154,24 @@ ++ show cradle findProjectCradle :: IO (Cradle Void)-findProjectCradle = do+findProjectCradle = findProjectCradle' True++findProjectCradle' :: Bool -> IO (Cradle Void)+findProjectCradle' log = do d <- getCurrentDirectory let initialFp = d </> "a" hieYaml <- Session.findCradle def initialFp -- Some log messages- case hieYaml of- Just yaml -> hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""- Nothing -> hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!"+ when log $+ case hieYaml of+ Just yaml -> hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ initialFp ++ "\""+ Nothing -> hPutStrLn stderr "No 'hie.yaml' found. Try to discover the project type!" Session.loadCradle def hieYaml d++trim :: String -> String+trim s = case lines s of+ [] -> s+ ls -> dropWhileEnd isSpace $ last ls
haskell-language-server.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 category: Development name: haskell-language-server-version: 1.6.1.1+version: 1.7.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -14,7 +14,7 @@ license: Apache-2.0 license-file: LICENSE build-type: Simple-tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.6 || == 8.10.7 || == 9.0.1 || == 9.0.2 || == 9.2.1+tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.6 || == 8.10.7 || == 9.0.2 || == 9.2.2 extra-source-files: README.md ChangeLog.md@@ -39,6 +39,7 @@ , extra , filepath , text+ , prettyprinter -- Default warnings in HLS common warnings@@ -70,13 +71,12 @@ , cryptohash-sha1 , data-default , ghc- , ghcide ^>=1.6+ , ghcide ^>=1.7 , githash , lsp , hie-bios , hiedb- , hls-plugin-api ^>=1.3- , hslogger+ , hls-plugin-api ^>=1.4 , optparse-applicative , optparse-simple , process@@ -133,7 +133,7 @@ flag rename description: Enable rename plugin- default: False+ default: True manual: True flag retrie@@ -181,6 +181,11 @@ default: True manual: True +flag changeTypeSignature+ description: Enable changeTypeSignature plugin+ default: True+ manual: True+ -- formatters flag floskell@@ -220,42 +225,42 @@ common class if flag(class) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-class-plugin ^>=1.0.0.1+ build-depends: hls-class-plugin ^>= 1.0 cpp-options: -Dclass common callHierarchy if flag(callHierarchy)- build-depends: hls-call-hierarchy-plugin ^>=1.0.0.0+ build-depends: hls-call-hierarchy-plugin ^>= 1.0 cpp-options: -DcallHierarchy common haddockComments if flag(haddockComments)- build-depends: hls-haddock-comments-plugin ^>=1.0.0.1+ build-depends: hls-haddock-comments-plugin ^>= 1.0 cpp-options: -DhaddockComments common eval if flag(eval)- build-depends: hls-eval-plugin ^>=1.2.0.0+ build-depends: hls-eval-plugin ^>= 1.2 cpp-options: -Deval common importLens if flag(importLens)- build-depends: hls-explicit-imports-plugin ^>=1.0.0.1+ build-depends: hls-explicit-imports-plugin ^>= 1.1 cpp-options: -DimportLens common refineImports if flag(refineImports)- build-depends: hls-refine-imports-plugin ^>=1.0.0.0+ build-depends: hls-refine-imports-plugin ^>=1.0 cpp-options: -DrefineImports common rename if flag(rename)- build-depends: hls-rename-plugin ^>= 1.0.0.0+ build-depends: hls-rename-plugin ^>= 1.0 cpp-options: -Drename common retrie if flag(retrie) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-retrie-plugin ^>=1.0.0.1+ build-depends: hls-retrie-plugin ^>= 1.0 cpp-options: -Dretrie common tactic@@ -265,17 +270,17 @@ common hlint if flag(hlint) && (impl(ghc < 9.2.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-hlint-plugin ^>=1.0.0.2+ build-depends: hls-hlint-plugin ^>= 1.0 cpp-options: -Dhlint common moduleName if flag(moduleName)- build-depends: hls-module-name-plugin ^>=1.0.0.0+ build-depends: hls-module-name-plugin ^>= 1.0 cpp-options: -DmoduleName common pragmas if flag(pragmas)- build-depends: hls-pragmas-plugin ^>=1.0.0.0+ build-depends: hls-pragmas-plugin ^>= 1.0 cpp-options: -Dpragmas common splice@@ -285,44 +290,49 @@ common alternateNumberFormat if flag(alternateNumberFormat)- build-depends: hls-alternate-number-format-plugin ^>=1.0.0.0+ build-depends: hls-alternate-number-format-plugin ^>= 1.1 cpp-options: -DalternateNumberFormat common qualifyImportedNames if flag(qualifyImportedNames)- build-depends: hls-qualify-imported-names-plugin ^>=1.0.0.0+ build-depends: hls-qualify-imported-names-plugin ^>=1.0 cpp-options: -DqualifyImportedNames common selectionRange if flag(selectionRange)- build-depends: hls-selection-range-plugin ^>=1.0.0.0+ build-depends: hls-selection-range-plugin ^>= 1.0 cpp-options: -DselectionRange +common changeTypeSignature+ if flag(changeTypeSignature)+ build-depends: hls-change-type-signature-plugin ^>= 1.0+ cpp-options: -DchangeTypeSignature+ -- formatters common floskell if flag(floskell)- build-depends: hls-floskell-plugin ^>=1.0.0.0+ build-depends: hls-floskell-plugin ^>= 1.0 cpp-options: -Dfloskell common fourmolu if flag(fourmolu)- build-depends: hls-fourmolu-plugin ^>=1.0.0.0+ build-depends: hls-fourmolu-plugin ^>= 1.0 cpp-options: -Dfourmolu common ormolu if flag(ormolu)- build-depends: hls-ormolu-plugin ^>=1.0.0.0+ build-depends: hls-ormolu-plugin ^>= 1.0 cpp-options: -Dormolu common stylishHaskell if flag(stylishHaskell) && (impl(ghc < 9.0.1) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-stylish-haskell-plugin ^>=1.0.0.0+ build-depends: hls-stylish-haskell-plugin ^>= 1.0 cpp-options: -DstylishHaskell common brittany if flag(brittany) && (impl(ghc < 9.0.2) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-brittany-plugin ^>=1.0.0.1+ build-depends: hls-brittany-plugin ^>= 1.0 cpp-options: -Dbrittany executable haskell-language-server@@ -333,6 +343,7 @@ -- plugins , example-plugins , callHierarchy+ , changeTypeSignature , class , haddockComments , eval@@ -398,7 +409,6 @@ , hiedb , lens , regex-tdfa- , hslogger , optparse-applicative , hls-plugin-api , lens@@ -442,6 +452,10 @@ , optparse-applicative , optparse-simple , process+ if !os(windows)+ build-depends:+ unix+ , containers default-language: Haskell2010 @@ -463,7 +477,7 @@ , lens , lens-aeson , ghcide- , hls-test-utils ^>=1.2+ , hls-test-utils ^>=1.3 , lsp-types , aeson , hls-plugin-api
plugins/default/src/Ide/Plugin/Example.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}@@ -12,6 +13,7 @@ module Ide.Plugin.Example ( descriptor+ , Log(..) ) where import Control.Concurrent.STM@@ -27,6 +29,7 @@ import Development.IDE as D import Development.IDE.Core.Shake (getDiagnostics, getHiddenDiagnostics)+import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat import GHC.Generics import Ide.PluginUtils@@ -38,9 +41,15 @@ -- --------------------------------------------------------------------- -descriptor :: PluginId -> PluginDescriptor IdeState-descriptor plId = (defaultPluginDescriptor plId)- { pluginRules = exampleRules+newtype Log = LogShake Shake.Log deriving Show++instance Pretty Log where+ pretty = \case+ LogShake log -> pretty log++descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder plId = (defaultPluginDescriptor plId)+ { pluginRules = exampleRules recorder , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd] , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction <> mkPluginHandler STextDocumentCodeLens codeLens@@ -74,9 +83,9 @@ type instance RuleResult Example = () -exampleRules :: Rules ()-exampleRules = do- define $ \Example file -> do+exampleRules :: Recorder (WithPriority Log) -> Rules ()+exampleRules recorder = do+ define (cmapWithPrio LogShake recorder) $ \Example file -> do _pm <- getParsedModule file let diag = mkDiag file "example" DsError (Range (Position 0 0) (Position 1 0)) "example diagnostic, hello world" return ([diag], Just ())
plugins/default/src/Ide/Plugin/Example2.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}@@ -12,6 +13,7 @@ module Ide.Plugin.Example2 ( descriptor+ , Log(..) ) where import Control.Concurrent.STM@@ -25,7 +27,8 @@ import qualified Data.Text as T import Data.Typeable import Development.IDE as D-import Development.IDE.Core.Shake+import Development.IDE.Core.Shake hiding (Log)+import qualified Development.IDE.Core.Shake as Shake import GHC.Generics import Ide.PluginUtils import Ide.Types@@ -35,9 +38,15 @@ -- --------------------------------------------------------------------- -descriptor :: PluginId -> PluginDescriptor IdeState-descriptor plId = (defaultPluginDescriptor plId)- { pluginRules = exampleRules+newtype Log = LogShake Shake.Log deriving Show++instance Pretty Log where+ pretty = \case+ LogShake log -> pretty log++descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder plId = (defaultPluginDescriptor plId)+ { pluginRules = exampleRules recorder , pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd] , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction <> mkPluginHandler STextDocumentCodeLens codeLens@@ -66,9 +75,9 @@ type instance RuleResult Example2 = () -exampleRules :: Rules ()-exampleRules = do- define $ \Example2 file -> do+exampleRules :: Recorder (WithPriority Log) -> Rules ()+exampleRules recorder = do+ define (cmapWithPrio LogShake recorder) $ \Example2 file -> do _pm <- getParsedModule file let diag = mkDiag file "example2" DsError (Range (Position 0 0) (Position 1 0)) "example2 diagnostic, hello world" return ([diag], Just ())
src/Ide/Arguments.hs view
@@ -1,151 +1,154 @@--- Copyright (c) 2019 The DAML Authors. All rights reserved. --- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above - -module Ide.Arguments - ( Arguments(..) - , GhcideArguments(..) - , PrintVersion(..) - , BiosAction(..) - , getArguments - , haskellLanguageServerVersion - , haskellLanguageServerNumericVersion - ) where - -import Data.Version -import Development.IDE (IdeState) -import Development.IDE.Main (Command (..), commandP) -import GitHash (giHash, tGitInfoCwdTry) -import Ide.Types (IdePlugins) -import Options.Applicative -import Paths_haskell_language_server -import System.Environment - --- --------------------------------------------------------------------- - -data Arguments - = VersionMode PrintVersion - | ProbeToolsMode - | ListPluginsMode - | BiosMode BiosAction - | Ghcide GhcideArguments - | VSCodeExtensionSchemaMode - | DefaultConfigurationMode - -data GhcideArguments = GhcideArguments - {argsCommand :: Command - ,argsCwd :: Maybe FilePath - ,argsShakeProfiling :: Maybe FilePath - ,argsTesting :: Bool - ,argsExamplePlugin :: Bool - -- These next two are for compatibility with existing hie clients, allowing - -- them to just change the name of the exe and still work. - , argsDebugOn :: Bool - , argsLogFile :: Maybe String - , argsThreads :: Int - , argsProjectGhcVersion :: Bool - } deriving Show - -data PrintVersion - = PrintVersion - | PrintNumericVersion - deriving (Show, Eq, Ord) - -data BiosAction - = PrintCradleType - deriving (Show, Eq, Ord) - -getArguments :: String -> IdePlugins IdeState -> IO Arguments -getArguments exeName plugins = execParser opts - where - opts = info (( - VersionMode <$> printVersionParser exeName - <|> probeToolsParser exeName - <|> listPluginsParser - <|> BiosMode <$> biosParser - <|> Ghcide <$> arguments plugins - ) - <**> helper) - ( fullDesc - <> progDesc "Used as a test bed to check your IDE Client will work" - <> header (exeName ++ " - GHC Haskell LSP server")) - -printVersionParser :: String -> Parser PrintVersion -printVersionParser exeName = - flag' PrintVersion - (long "version" <> help ("Show " ++ exeName ++ " and GHC versions")) - <|> - flag' PrintNumericVersion - (long "numeric-version" <> help ("Show numeric version of " ++ exeName)) - -biosParser :: Parser BiosAction -biosParser = - flag' PrintCradleType - (long "print-cradle" <> help "Print the project cradle type") - -probeToolsParser :: String -> Parser Arguments -probeToolsParser exeName = - flag' ProbeToolsMode - (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest")) - -listPluginsParser :: Parser Arguments -listPluginsParser = - flag' ListPluginsMode - (long "list-plugins" <> help "List all available plugins") - -arguments :: IdePlugins IdeState -> Parser GhcideArguments -arguments plugins = GhcideArguments - <$> (commandP plugins <|> lspCommand <|> checkCommand) - <*> optional (strOption $ long "cwd" <> metavar "DIR" - <> help "Change to this directory") - <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" - <> help "Dump profiling reports to this directory") - <*> switch (long "test" - <> help "Enable additional lsp messages used by the testsuite") - <*> switch (long "example" - <> help "Include the Example Plugin. For Plugin devs only") - - <*> switch - ( long "debug" - <> short 'd' - <> help "Generate debug output" - ) - <*> optional (strOption - ( long "logfile" - <> short 'l' - <> metavar "LOGFILE" - <> help "File to log to, defaults to stdout" - )) - <*> option auto - (short 'j' - <> help "Number of threads (0: automatic)" - <> metavar "NUM" - <> value 0 - <> showDefault - ) - <*> switch (long "project-ghc-version" - <> help "Work out the project GHC version and print it") - where - lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server") - checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) - --- --------------------------------------------------------------------- - -haskellLanguageServerNumericVersion :: String -haskellLanguageServerNumericVersion = showVersion version - -haskellLanguageServerVersion :: IO String -haskellLanguageServerVersion = do - path <- getExecutablePath - let gi = $$tGitInfoCwdTry - gitHashSection = case gi of - Right gi -> " (GIT hash: " <> giHash gi <> ")" - Left _ -> "" - return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion - <> " (GHC: " <> VERSION_ghc - <> ") (PATH: " <> path <> ")" - <> gitHashSection +-- Copyright (c) 2019 The DAML Authors. All rights reserved.+-- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above++module Ide.Arguments+ ( Arguments(..)+ , GhcideArguments(..)+ , PrintVersion(..)+ , BiosAction(..)+ , getArguments+ , haskellLanguageServerVersion+ , haskellLanguageServerNumericVersion+ ) where++import Data.Version+import Development.IDE (IdeState)+import Development.IDE.Main (Command (..), commandP)+import GitHash (giHash, tGitInfoCwdTry)+import Ide.Types (IdePlugins)+import Options.Applicative+import Paths_haskell_language_server+import System.Environment++-- ---------------------------------------------------------------------++data Arguments+ = VersionMode PrintVersion+ | ProbeToolsMode+ | ListPluginsMode+ | BiosMode BiosAction+ | Ghcide GhcideArguments+ | VSCodeExtensionSchemaMode+ | DefaultConfigurationMode+ | PrintLibDir++data GhcideArguments = GhcideArguments+ {argsCommand :: Command+ ,argsCwd :: Maybe FilePath+ ,argsShakeProfiling :: Maybe FilePath+ ,argsTesting :: Bool+ ,argsExamplePlugin :: Bool+ -- These next two are for compatibility with existing hie clients, allowing+ -- them to just change the name of the exe and still work.+ , argsDebugOn :: Bool+ , argsLogFile :: Maybe String+ , argsThreads :: Int+ , argsProjectGhcVersion :: Bool+ } deriving Show++data PrintVersion+ = PrintVersion+ | PrintNumericVersion+ deriving (Show, Eq, Ord)++data BiosAction+ = PrintCradleType+ deriving (Show, Eq, Ord)++getArguments :: String -> IdePlugins IdeState -> IO Arguments+getArguments exeName plugins = execParser opts+ where+ opts = info ((+ VersionMode <$> printVersionParser exeName+ <|> probeToolsParser exeName+ <|> listPluginsParser+ <|> BiosMode <$> biosParser+ <|> Ghcide <$> arguments plugins+ <|> flag' PrintLibDir (long "print-libdir" <> help "Print project GHCs libdir")+ )+ <**> helper)+ ( fullDesc+ <> progDesc "Used as a test bed to check your IDE Client will work"+ <> header (exeName ++ " - GHC Haskell LSP server"))++printVersionParser :: String -> Parser PrintVersion+printVersionParser exeName =+ flag' PrintVersion+ (long "version" <> help ("Show " ++ exeName ++ " and GHC versions"))+ <|>+ flag' PrintNumericVersion+ (long "numeric-version" <> help ("Show numeric version of " ++ exeName))++biosParser :: Parser BiosAction+biosParser =+ flag' PrintCradleType+ (long "print-cradle" <> help "Print the project cradle type")++probeToolsParser :: String -> Parser Arguments+probeToolsParser exeName =+ flag' ProbeToolsMode+ (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest"))++listPluginsParser :: Parser Arguments+listPluginsParser =+ flag' ListPluginsMode+ (long "list-plugins" <> help "List all available plugins")++arguments :: IdePlugins IdeState -> Parser GhcideArguments+arguments plugins = GhcideArguments+ <$> (commandP plugins <|> lspCommand <|> checkCommand)+ <*> optional (strOption $ long "cwd" <> metavar "DIR"+ <> help "Change to this directory")+ <*> optional (strOption $ long "shake-profiling" <> metavar "DIR"+ <> help "Dump profiling reports to this directory")+ <*> switch (long "test"+ <> help "Enable additional lsp messages used by the testsuite")+ <*> switch (long "example"+ <> help "Include the Example Plugin. For Plugin devs only")++ <*> switch+ ( long "debug"+ <> short 'd'+ <> help "Generate debug output"+ )+ <*> optional (strOption+ ( long "logfile"+ <> short 'l'+ <> metavar "LOGFILE"+ <> help "File to log to, defaults to stdout"+ ))+ <*> option auto+ (short 'j'+ <> help "Number of threads (0: automatic)"+ <> metavar "NUM"+ <> value 0+ <> showDefault+ )+ <*> switch (long "project-ghc-version"+ <> help "Work out the project GHC version and print it")+ where+ lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server")+ checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))++-- ---------------------------------------------------------------------++haskellLanguageServerNumericVersion :: String+haskellLanguageServerNumericVersion = showVersion version++haskellLanguageServerVersion :: IO String+haskellLanguageServerVersion = do+ path <- getExecutablePath+ let gi = $$tGitInfoCwdTry+ gitHashSection = case gi of+ Right gi -> " (GIT hash: " <> giHash gi <> ")"+ Left _ -> ""+ return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion+ <> " (GHC: " <> VERSION_ghc+ <> ") (PATH: " <> path <> ")"+ <> gitHashSection+
src/Ide/Main.hs view
@@ -5,38 +5,62 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Main(defaultMain, runLspMode) where+module Ide.Main(defaultMain, runLspMode, Log(..)) where import Control.Monad.Extra import qualified Data.Aeson.Encode.Pretty as A import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Coerce (coerce) import Data.Default import Data.List (sort)+import Data.Text (Text) import qualified Data.Text as T-import Development.IDE.Core.Rules+import Development.IDE.Core.Rules hiding (Log, logToPriority) import Development.IDE.Core.Tracing (withTelemetryLogger)-import Development.IDE.Graph (ShakeOptions (shakeThreads)) import Development.IDE.Main (isLSP)-import qualified Development.IDE.Main as Main+import qualified Development.IDE.Main as IDEMain import qualified Development.IDE.Session as Session import Development.IDE.Types.Logger as G import qualified Development.IDE.Types.Options as Ghcide+import GHC.Stack (emptyCallStack)+import qualified HIE.Bios.Environment as HieBios+import HIE.Bios.Types import Ide.Arguments-import Ide.Logger import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) import Ide.Types (IdePlugins, PluginId (PluginId), ipMap) import Ide.Version-import qualified Language.LSP.Server as LSP+import System.Directory import qualified System.Directory.Extra as IO-import System.IO-import qualified System.Log.Logger as L+import System.FilePath -defaultMain :: Arguments -> IdePlugins IdeState -> IO ()-defaultMain args idePlugins = do+data Log+ = LogVersion !String+ | LogDirectory !FilePath+ | LogLspStart !GhcideArguments ![PluginId]+ | LogIDEMain IDEMain.Log+ | LogOther T.Text+ deriving Show++instance Pretty Log where+ pretty log = case log of+ LogVersion version -> pretty version+ LogDirectory path -> "Directory:" <+> pretty path+ LogLspStart ghcideArgs pluginIds ->+ nest 2 $+ vsep+ [ "Starting (haskell-language-server) LSP server..."+ , viaShow ghcideArgs+ , "PluginIds:" <+> pretty (coerce @_ @[Text] pluginIds) ]+ LogIDEMain iDEMainLog -> pretty iDEMainLog+ LogOther t -> pretty t++defaultMain :: Recorder (WithPriority Log) -> Arguments -> IdePlugins IdeState -> IO ()+defaultMain recorder args idePlugins = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work @@ -68,52 +92,46 @@ Ghcide ghcideArgs -> do {- see WARNING above -}- hPutStrLn stderr hlsVer- runLspMode ghcideArgs idePlugins+ logWith recorder Info $ LogVersion hlsVer+ runLspMode recorder ghcideArgs idePlugins VSCodeExtensionSchemaMode -> do LBS.putStrLn $ A.encodePretty $ pluginsToVSCodeExtensionSchema idePlugins DefaultConfigurationMode -> do LBS.putStrLn $ A.encodePretty $ pluginsToDefaultConfig idePlugins---- -----------------------------------------------------------------------hlsLogger :: G.Logger-hlsLogger = G.Logger $ \pri txt ->- case pri of- G.Telemetry -> logm (T.unpack txt)- G.Debug -> debugm (T.unpack txt)- G.Info -> logm (T.unpack txt)- G.Warning -> warningm (T.unpack txt)- G.Error -> errorm (T.unpack txt)+ PrintLibDir -> do+ d <- getCurrentDirectory+ let initialFp = d </> "a"+ hieYaml <- Session.findCradle def initialFp+ cradle <- Session.loadCradle def hieYaml d+ (CradleSuccess libdir) <- HieBios.getRuntimeGhcLibDir cradle+ putStr libdir -- --------------------------------------------------------------------- -runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()-runLspMode ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLogger $ \telemetryLogger -> do+runLspMode :: Recorder (WithPriority Log) -> GhcideArguments -> IdePlugins IdeState -> IO ()+runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLogger $ \telemetryLogger -> do+ let log = logWith recorder whenJust argsCwd IO.setCurrentDirectory dir <- IO.getCurrentDirectory- LSP.setupLogger argsLogFile ["hls", "hie-bios"]- $ if argsDebugOn then L.DEBUG else L.INFO+ log Info $ LogDirectory dir when (isLSP argsCommand) $ do- hPutStrLn stderr "Starting (haskell-language-server)LSP server..."- hPutStrLn stderr $ " with arguments: " <> show ghcideArgs- hPutStrLn stderr $ " with plugins: " <> show (map fst $ ipMap idePlugins)- hPutStrLn stderr $ " in directory: " <> dir+ log Info $ LogLspStart ghcideArgs (map fst $ ipMap idePlugins) - Main.defaultMain def- { Main.argCommand = argsCommand- , Main.argsHlsPlugins = idePlugins- , Main.argsLogger = pure hlsLogger <> pure telemetryLogger- , Main.argsThreads = if argsThreads == 0 then Nothing else Just $ fromIntegral argsThreads- , Main.argsIdeOptions = \_config sessionLoader ->+ -- exists so old-style logging works. intended to be phased out+ let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack $ LogOther m)++ IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger)+ { IDEMain.argCommand = argsCommand+ , IDEMain.argsHlsPlugins = idePlugins+ , IDEMain.argsLogger = pure logger <> pure telemetryLogger+ , IDEMain.argsThreads = if argsThreads == 0 then Nothing else Just $ fromIntegral argsThreads+ , IDEMain.argsIdeOptions = \_config sessionLoader -> let defOptions = Ghcide.defaultIdeOptions sessionLoader in defOptions { Ghcide.optShakeProfiling = argsShakeProfiling , Ghcide.optTesting = Ghcide.IdeTesting argsTesting- , Ghcide.optShakeOptions = (Ghcide.optShakeOptions defOptions)- {shakeThreads = argsThreads} } }
src/Ide/Version.hs view
@@ -1,82 +1,82 @@-{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} --- | Information and display strings for HIE's version --- and the current project's version -module Ide.Version where - -import Data.Maybe (listToMaybe) -import Data.Version -import GitHash (giCommitCount, tGitInfoCwdTry) -import Options.Applicative.Simple (simpleVersion) -import qualified Paths_haskell_language_server as Meta -import System.Directory -import System.Exit -import System.Info -import System.Process -import Text.ParserCombinators.ReadP - --- >>> hlsVersion -hlsVersion :: String -hlsVersion = - let gi = $$tGitInfoCwdTry - commitCount = case gi of - Right gi -> show $ giCommitCount gi - Left _ -> "UNKNOWN" - in concat $ concat - [ [$(simpleVersion Meta.version)] - -- Leave out number of commits for --depth=1 clone - -- See https://github.com/commercialhaskell/stack/issues/792 - , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) && - commitCount /= ("UNKNOWN" :: String)] - , [" ", arch] - , [" ", hlsGhcDisplayVersion] - ] - where - hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc - -data ProgramsOfInterest = ProgramsOfInterest - { cabalVersion :: Maybe Version - , stackVersion :: Maybe Version - , ghcVersion :: Maybe Version - } - -showProgramVersionOfInterest :: ProgramsOfInterest -> String -showProgramVersionOfInterest ProgramsOfInterest {..} = - unlines - [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion - , "stack:\t\t" ++ showVersionWithDefault stackVersion - , "ghc:\t\t" ++ showVersionWithDefault ghcVersion - ] - where - showVersionWithDefault :: Maybe Version -> String - showVersionWithDefault = maybe "Not found" showVersion - -findProgramVersions :: IO ProgramsOfInterest -findProgramVersions = ProgramsOfInterest - <$> findVersionOf "cabal" - <*> findVersionOf "stack" - <*> findVersionOf "ghc" - --- | Find the version of the given program. --- Assumes the program accepts the cli argument "--numeric-version". --- If the invocation has a non-zero exit-code, we return 'Nothing' -findVersionOf :: FilePath -> IO (Maybe Version) -findVersionOf tool = - findExecutable tool >>= \case - Nothing -> pure Nothing - Just path -> - readProcessWithExitCode path ["--numeric-version"] "" >>= \case - (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout - _ -> pure Nothing - where - myVersionParser = do - skipSpaces - version <- parseVersion - skipSpaces - pure version - - consumeParser :: ReadP a -> String -> Maybe a - consumeParser p input = listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input +{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Information and display strings for HIE's version+-- and the current project's version+module Ide.Version where++import Data.Maybe (listToMaybe)+import Data.Version+import GitHash (giCommitCount, tGitInfoCwdTry)+import Options.Applicative.Simple (simpleVersion)+import qualified Paths_haskell_language_server as Meta+import System.Directory+import System.Exit+import System.Info+import System.Process+import Text.ParserCombinators.ReadP++-- >>> hlsVersion+hlsVersion :: String+hlsVersion =+ let gi = $$tGitInfoCwdTry+ commitCount = case gi of+ Right gi -> show $ giCommitCount gi+ Left _ -> "UNKNOWN"+ in concat $ concat+ [ [$(simpleVersion Meta.version)]+ -- Leave out number of commits for --depth=1 clone+ -- See https://github.com/commercialhaskell/stack/issues/792+ , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&+ commitCount /= ("UNKNOWN" :: String)]+ , [" ", arch]+ , [" ", hlsGhcDisplayVersion]+ ]+ where+ hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc++data ProgramsOfInterest = ProgramsOfInterest+ { cabalVersion :: Maybe Version+ , stackVersion :: Maybe Version+ , ghcVersion :: Maybe Version+ }++showProgramVersionOfInterest :: ProgramsOfInterest -> String+showProgramVersionOfInterest ProgramsOfInterest {..} =+ unlines+ [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion+ , "stack:\t\t" ++ showVersionWithDefault stackVersion+ , "ghc:\t\t" ++ showVersionWithDefault ghcVersion+ ]+ where+ showVersionWithDefault :: Maybe Version -> String+ showVersionWithDefault = maybe "Not found" showVersion++findProgramVersions :: IO ProgramsOfInterest+findProgramVersions = ProgramsOfInterest+ <$> findVersionOf "cabal"+ <*> findVersionOf "stack"+ <*> findVersionOf "ghc"++-- | Find the version of the given program.+-- Assumes the program accepts the cli argument "--numeric-version".+-- If the invocation has a non-zero exit-code, we return 'Nothing'+findVersionOf :: FilePath -> IO (Maybe Version)+findVersionOf tool =+ findExecutable tool >>= \case+ Nothing -> pure Nothing+ Just path ->+ readProcessWithExitCode path ["--numeric-version"] "" >>= \case+ (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout+ _ -> pure Nothing+ where+ myVersionParser = do+ skipSpaces+ version <- parseVersion+ skipSpaces+ pure version++ consumeParser :: ReadP a -> String -> Maybe a+ consumeParser p input = listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input
test/functional/Completion.hs view
@@ -4,6 +4,7 @@ import Control.Lens hiding ((.=)) import Data.Aeson (object, (.=))+import Data.Foldable (find) import qualified Data.Text as T import Ide.Plugin.Config (maxCompletions) import Language.LSP.Types.Lens hiding (applyEdit)@@ -19,7 +20,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9)- let item = head $ filter ((== "putStrLn") . (^. label)) compls+ item <- getCompletionByLabel "putStrLn" compls liftIO $ do item ^. label @?= "putStrLn" item ^. kind @?= Just CiFunction@@ -35,7 +36,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9)- let item = head $ filter ((== "putStrLn") . (^. label)) compls+ item <- getCompletionByLabel "putStrLn" compls resolvedRes <- request SCompletionItemResolve item let eResolved = resolvedRes ^. result case eResolved of@@ -56,7 +57,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 1 23)- let item = head $ filter ((== "Maybe") . (^. label)) compls+ item <- getCompletionByLabel "Maybe" compls liftIO $ do item ^. label @?= "Maybe" item ^. detail @?= Just "Data.Maybe"@@ -71,7 +72,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 2 24)- let item = head $ filter ((== "List") . (^. label)) compls+ item <- getCompletionByLabel "List" compls liftIO $ do item ^. label @?= "List" item ^. detail @?= Just "Data.List"@@ -91,7 +92,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 4)- let item = head $ filter (\c -> c^.label == "accessor") compls+ item <- getCompletionByLabel "accessor" compls liftIO $ do item ^. label @?= "accessor" item ^. kind @?= Just CiFunction@@ -101,7 +102,7 @@ let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9)- let item = head $ filter ((== "id") . (^. label)) compls+ item <- getCompletionByLabel "id" compls liftIO $ do item ^. detail @?= Just ":: a -> a" @@ -111,7 +112,7 @@ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11)- let item = head $ filter ((== "flip") . (^. label)) compls+ item <- getCompletionByLabel "flip" compls liftIO $ item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c" @@ -128,7 +129,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 31)- let item = head $ filter ((== "Alternative") . (^. label)) compls+ item <- getCompletionByLabel "Alternative" compls liftIO $ do item ^. label @?= "Alternative" item ^. kind @?= Just CiFunction@@ -141,7 +142,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 41)- let item = head $ filter ((== "liftA") . (^. label)) compls+ item <- getCompletionByLabel "liftA" compls liftIO $ do item ^. label @?= "liftA" item ^. kind @?= Just CiFunction@@ -159,10 +160,10 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 14)- let item = head $ filter ((== "Nothing") . (^. label)) compls+ item <- getCompletionByLabel "Nothing" compls liftIO $ do item ^. insertTextFormat @?= Just Snippet- item ^. insertText @?= Just "Nothing "+ item ^. insertText @?= Just "Nothing" , testCase "work for polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell"@@ -171,7 +172,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11)- let item = head $ filter ((== "foldl") . (^. label)) compls+ item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction@@ -185,7 +186,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11)- let item = head $ filter ((== "mapM") . (^. label)) compls+ item <- getCompletionByLabel "mapM" compls liftIO $ do item ^. label @?= "mapM" item ^. kind @?= Just CiFunction@@ -199,7 +200,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18)- let item = head $ filter ((== "filter") . (^. label)) compls+ item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction@@ -213,7 +214,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18)- let item = head $ filter ((== "filter") . (^. label)) compls+ item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction@@ -227,7 +228,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29)- let item = head $ filter ((== "intersperse") . (^. label)) compls+ item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction@@ -241,7 +242,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29)- let item = head $ filter ((== "intersperse") . (^. label)) compls+ item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction@@ -268,7 +269,9 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 1 6)- let item = head $ filter (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls+ item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of+ Just c -> pure c+ Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls liftIO $ do item ^. insertTextFormat @?= Just Snippet item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}"@@ -279,7 +282,7 @@ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11)- let item = head $ filter ((== "foldl") . (^. label)) compls+ item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction@@ -327,11 +330,11 @@ ] shouldContainCompl :: [CompletionItem] -> T.Text -> Assertion-compls `shouldContainCompl` x =- any ((== x) . (^. label)) compls- @? "Should contain completion: " ++ show x+compls `shouldContainCompl` lbl =+ any ((== lbl) . (^. label)) compls+ @? "Should contain completion: " ++ show lbl shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion-compls `shouldNotContainCompl` x =- all ((/= x) . (^. label)) compls- @? "Should not contain completion: " ++ show x+compls `shouldNotContainCompl` lbl =+ all ((/= lbl) . (^. label)) compls+ @? "Should not contain completion: " ++ show lbl
test/functional/FunctionalCodeAction.hs view
@@ -43,7 +43,7 @@ cars <- getAllCodeActions doc replaceButStrLn <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"] executeCommand replaceButStrLn- _ <- anyRequest+ _ <- skipManyTill loggingNotification anyRequest x:_ <- T.lines <$> documentContents doc liftIO $ x @?= "main = putStrLn \"hello\""@@ -65,7 +65,7 @@ _ -> error $ "Unexpected arguments: " ++ show mbArgs executeCommand cmd- _ <- anyRequest+ _ <- skipManyTill loggingNotification anyRequest x1:x2:_ <- T.lines <$> documentContents doc liftIO $@@ -139,7 +139,8 @@ -- ignore the first empty hlint diagnostic publish [_,_:diag:_] <- count 2 $ waitForDiagnosticsFrom doc - let prefixes = [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6+ let prefixes =+ [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6 , "Could not find module `Codec.Compression.GZip'" -- Windows , "Could not load module ‘Codec.Compression.GZip’" -- GHC >= 8.6 , "Could not find module ‘Codec.Compression.GZip’"@@ -148,7 +149,9 @@ mActions <- getAllCodeActions doc let allActions = map fromAction mActions- action = head allActions+ action <- case allActions of+ (a:_) -> pure a+ _ -> liftIO $ assertFailure "Expected non-empty list of actions" liftIO $ do action ^. L.title @?= "Add zlib as a dependency"@@ -204,7 +207,7 @@ cas <- getAllCodeActions doc cmd <- liftIO $ inspectCommand cas ["redundant import"] executeCommand cmd- _ <- anyRequest+ _ <- skipManyTill loggingNotification anyRequest contents <- documentContents doc liftIO $ T.lines contents @?= [ "{-# OPTIONS_GHC -Wunused-imports #-}"
+ test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+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++version :: Version+version = Version [0,1,0,0] []+bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath++bindir = "/home/zubin/.cabal/bin"+libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-8.10.3/test-0.1.0.0-inplace"+dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-8.10.3"+datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-8.10.3/test-0.1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-8.10.3/test-0.1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath+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)++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir ++ "/" ++ name)