Probe for the version of common tools (#306)

Print them to stderr when starting the server.
Adds cli command `--probe-tools` for easier debugging.

Author: fendor

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")

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])

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

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
+