diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -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" diff --git a/exe/Plugins.hs b/exe/Plugins.hs --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -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" ] diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -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 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: 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 @@ -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 diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -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 ()) diff --git a/plugins/default/src/Ide/Plugin/Example2.hs b/plugins/default/src/Ide/Plugin/Example2.hs --- a/plugins/default/src/Ide/Plugin/Example2.hs +++ b/plugins/default/src/Ide/Plugin/Example2.hs @@ -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 ()) diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -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 + diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -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} } } diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -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 diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -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 diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -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 #-}" diff --git a/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs new file mode 100644 --- /dev/null +++ b/test/testdata/wErrorTest/dist-newstyle/build/x86_64-linux/ghc-8.10.3/test-0.1.0.0/build/autogen/Paths_test.hs @@ -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)