Probe-tools: Print stack ghc version (haskell#3093)

* Probe-tools: Print stack ghc version

The ghc version on the $PATH is often not relevant for stack projects.
The ghc version stack is using is printed in addition.

* Probetools: cradle ghc version added to wrapper

* Revert stack ghc changes to Ide.Main

* Update exe/Wrapper.hs

Co-authored-by: fendor <[email protected]>

* Probe tools: Print version with padded spaces

Addressing <haskell#3093 (comment)>

Co-authored-by: fendor <[email protected]>

Author: 2 people

exe/Wrapper.hs

@@ -14,6 +14,7 @@ module Main where
 import           Control.Monad.Extra
 import           Data.Char                          (isSpace)
 import           Data.Default
+import           Data.Either.Extra                  (eitherToMaybe)
 import           Data.Foldable
 import           Data.List
 import           Data.Void
@@ -79,6 +80,10 @@ main = do
           putStrLn hlsVer
           putStrLn "Tool versions found on the $PATH"
           putStrLn $ showProgramVersionOfInterest programsOfInterest
+          putStrLn "Tool versions in your project"
+          cradle <- findProjectCradle' False
+          ghcVersion <- runExceptT $ getRuntimeGhcVersion' cradle
+          putStrLn $ showProgramVersion "ghc" $ mkVersion =<< eitherToMaybe ghcVersion
 
       VersionMode PrintVersion ->
           putStrLn hlsVer

src/Ide/Version.hs

@@ -46,13 +46,17 @@ data ProgramsOfInterest = ProgramsOfInterest
 showProgramVersionOfInterest :: ProgramsOfInterest -> String
 showProgramVersionOfInterest ProgramsOfInterest {..} =
   unlines
-    [ "cabal:\t\t" ++ showVersionWithDefault cabalVersion
-    , "stack:\t\t" ++ showVersionWithDefault stackVersion
-    , "ghc:\t\t" ++ showVersionWithDefault ghcVersion
+    [ showProgramVersion "cabal" cabalVersion
+    , showProgramVersion "stack" stackVersion
+    , showProgramVersion "ghc" ghcVersion
     ]
+
+showProgramVersion :: String -> Maybe Version -> String
+showProgramVersion name version =
+  pad 16 (name ++ ":") ++ showVersionWithDefault version
   where
-    showVersionWithDefault :: Maybe Version -> String
     showVersionWithDefault = maybe "Not found" showVersion
+    pad n s = s ++ replicate (n - length s) ' '
 
 findProgramVersions :: IO ProgramsOfInterest
 findProgramVersions = ProgramsOfInterest
@@ -69,8 +73,11 @@ findVersionOf tool =
     Nothing -> pure Nothing
     Just path ->
       readProcessWithExitCode path ["--numeric-version"] "" >>= \case
-        (ExitSuccess, sout, _) -> pure $ consumeParser myVersionParser sout
+        (ExitSuccess, sout, _) -> pure $ mkVersion sout
         _                      -> pure Nothing
+
+mkVersion :: String -> Maybe Version
+mkVersion = consumeParser myVersionParser
   where
     myVersionParser = do
       skipSpaces
@@ -79,4 +86,5 @@ findVersionOf tool =
       pure version
 
     consumeParser :: ReadP a -> String -> Maybe a
-    consumeParser p input = listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input
+    consumeParser p input =
+      listToMaybe $ map fst . filter (null . snd) $ readP_to_S p input