From 371e22678b0ea623491f05de95bb99a0edfd053c Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 10 Aug 2020 14:08:41 +0200 Subject: [PATCH] Probe for the version of common tools Print them to stderr when starting the server. Adds cli command `--probe-tools` for easier debugging. --- exe/Arguments.hs | 7 +++++++ exe/Main.hs | 12 +++++++++++ exe/Wrapper.hs | 12 ++++++++++- src/Ide/Version.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 80 insertions(+), 1 deletion(-) diff --git a/exe/Arguments.hs b/exe/Arguments.hs index 201d37a89d..9ca5568829 100644 --- a/exe/Arguments.hs +++ b/exe/Arguments.hs @@ -26,6 +26,7 @@ import System.Environment data Arguments = VersionMode PrintVersion + | ProbeToolsMode | LspMode LspArguments deriving Show @@ -54,6 +55,7 @@ getArguments exeName = execParser opts where opts = info (( VersionMode <$> printVersionParser exeName + <|> probeToolsParser exeName <|> LspMode <$> arguments) <**> helper) ( fullDesc @@ -68,6 +70,11 @@ printVersionParser exeName = flag' PrintNumericVersion (long "numeric-version" <> help ("Show numeric version of " ++ exeName)) +probeToolsParser :: String -> Parser Arguments +probeToolsParser exeName = + flag' ProbeToolsMode + (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest")) + arguments :: Parser LspArguments arguments = LspArguments <$> switch (long "lsp" <> help "Start talking to an LSP server") diff --git a/exe/Main.hs b/exe/Main.hs index 725a752b95..4d7518ca88 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -44,6 +44,7 @@ import HIE.Bios.Cradle import qualified Language.Haskell.LSP.Core as LSP import Ide.Logger import Ide.Plugin +import Ide.Version import Ide.Plugin.Config import Ide.Types (IdePlugins, ipMap) import Language.Haskell.LSP.Messages @@ -133,6 +134,12 @@ main = do hlsVer <- haskellLanguageServerVersion case args of + ProbeToolsMode -> do + programsOfInterest <- findProgramVersions + putStrLn hlsVer + putStrLn "Tool versions found on the $PATH" + putStrLn $ showProgramVersionOfInterest programsOfInterest + VersionMode PrintVersion -> putStrLn hlsVer @@ -176,6 +183,7 @@ runLspMode lspArgs@LspArguments {..} = do hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins') hPutStrLn stderr $ " in directory: " <> dir hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" + runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg _getConfig -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -199,6 +207,10 @@ runLspMode lspArgs@LspArguments {..} = do putStrLn $ "(haskell-language-server)Ghcide setup tester in " ++ dir ++ "." putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues" + programsOfInterest <- findProgramVersions + putStrLn "" + putStrLn "Tool versions found on the $PATH" + putStrLn $ showProgramVersionOfInterest programsOfInterest putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir files <- expandFiles (argFiles ++ ["." | null argFiles]) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 17c024f2a7..cdcea7cb04 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -30,6 +30,12 @@ main = do hlsVer <- haskellLanguageServerVersion case args of + ProbeToolsMode -> do + programsOfInterest <- findProgramVersions + putStrLn hlsVer + putStrLn "Tool versions found on the $PATH" + putStrLn $ showProgramVersionOfInterest programsOfInterest + VersionMode PrintVersion -> putStrLn hlsVer @@ -60,7 +66,11 @@ launchHaskellLanguageServer LspArguments{..} = do hPutStrLn stderr $ "Arguments: " ++ show args hPutStrLn stderr $ "Cradle directory: " ++ cradleRootDir cradle hPutStrLn stderr $ "Cradle type: " ++ show (actionName (cradleOptsProg cradle)) - + programsOfInterest <- findProgramVersions + hPutStrLn stderr "" + hPutStrLn stderr "Tool versions found on the $PATH" + hPutStrLn stderr $ showProgramVersionOfInterest programsOfInterest + hPutStrLn stderr "" -- Get the ghc version -- this might fail! hPutStrLn stderr $ "Consulting the cradle to get project GHC version..." ghcVersion <- getRuntimeGhcVersion' cradle diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs index fcb9f2376b..ae5a62cc5b 100644 --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,6 +11,11 @@ import Development.GitRev (gitCommitCount) import Options.Applicative.Simple (simpleVersion) import qualified Paths_haskell_language_server as Meta import System.Info +import Data.Version +import Data.Maybe (listToMaybe) +import System.Process +import System.Exit +import Text.ParserCombinators.ReadP hlsVersion :: String hlsVersion = @@ -24,3 +31,46 @@ hlsVersion = ] where hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc + +data ProgramsOfInterest = ProgramsOfInterest + { cabalVersion :: Maybe Version + , stackVersion :: Maybe Version + , ghcVersion :: Maybe Version + } + +showProgramVersionOfInterest :: ProgramsOfInterest -> String +showProgramVersionOfInterest ProgramsOfInterest {..} = + unlines + [ concat ["cabal:\t\t", showVersionWithDefault cabalVersion] + , concat ["stack:\t\t", showVersionWithDefault stackVersion] + , concat ["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 = + readProcessWithExitCode tool ["--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 +