Add stack path --compiler-path commercialhaskell#1546

ChangeLog.md

@@ -13,6 +13,8 @@ Behavior changes:
 * `stack init` now ignores symlinks when searching for cabal files. It also now
   ignores any directory that begins with `.` (as well as `dist` dirs) - before
   it would only ignore `.git`, `.stack-work`, and `dist`.
+* `stack path --ghc-paths` is replaced with `--compiler-path` which points
+  directly at the binary used in the current project.
 
 Other enhancements:
 

doc/GUIDE.md

@@ -1473,7 +1473,7 @@ global-stack-root: /home/michael/.stack
 project-root: /home/michael/wai
 config-location: /home/michael/wai/stack.yaml
 bin-path: /home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4/bin:/home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin:/home/michael/.stack/programs/x86_64-linux/ghc-7.10.2/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin
-ghc-paths: /home/michael/.stack/programs/x86_64-linux
+compiler-path: /home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin/ghc
 local-bin-path: /home/michael/.local/bin
 extra-include-dirs:
 extra-library-dirs:
@@ -1487,17 +1487,14 @@ dist-dir: .stack-work/dist/x86_64-linux/Cabal-1.18.1.5
 ```
 
 In addition, `stack path` accepts command line arguments to state which of
-these keys you're interested in, which can be convenient for scripting. As a
-simple example, let's find out which versions of GHC are installed locally:
+these keys you're interested in, which can be convenient for scripting. As an
+example, let's just get the path to the version of GHC we're using.
 
 ```
-michael@d30748af6d3d:~/wai$ ls $(stack path --ghc-paths)/*.installed
-/home/michael/.stack/programs/x86_64-linux/ghc-7.10.2.installed
-/home/michael/.stack/programs/x86_64-linux/ghc-7.8.4.installed
+michael@d30748af6d3d:~/wai$ stack path --compiler-path
+/home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin/ghc
 ```
 
-(Yes, that command requires a \*nix shell, and likely won't run on Windows.)
-
 While we're talking about paths, to wipe our stack install completely, here's
 what needs to be removed:
 

src/Stack/Build/Execute.hs

@@ -23,7 +23,7 @@ import           Control.Concurrent.MVar.Lifted
 import           Control.Concurrent.STM
 import           Control.Exception.Enclosed (catchIO)
 import           Control.Exception.Lifted
-import           Control.Monad (liftM, when, unless, void, join)
+import           Control.Monad (liftM, when, unless, void)
 import           Control.Monad.Catch (MonadCatch, MonadMask)
 import           Control.Monad.Extra (anyM, (&&^))
 import           Control.Monad.IO.Class
@@ -785,11 +785,8 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
                 , esLocaleUtf8 = True
                 }
         menv <- liftIO $ configEnvOverride config envSettings
-        -- When looking for ghc to build Setup.hs we want to ignore local binaries, see:
-        -- https://github.com/commercialhaskell/stack/issues/1052
-        menvWithoutLocals <- liftIO $ configEnvOverride config envSettings { esIncludeLocals = False }
-        getGhcPath <- runOnce $ liftIO $ join $ findExecutable menvWithoutLocals "ghc"
-        getGhcjsPath <- runOnce $ liftIO $ join $ findExecutable menvWithoutLocals "ghcjs"
+        getGhcPath <- runOnce $ getCompilerPath Ghc
+        getGhcjsPath <- runOnce $ getCompilerPath Ghcjs
         distRelativeDir' <- distRelativeDir
         esetupexehs <-
             -- Avoid broken Setup.hs files causing problems for simple build

src/Stack/Types/Config.hs

@@ -43,6 +43,7 @@ module Stack.Types.Config
   ,EnvConfig(..)
   ,HasEnvConfig(..)
   ,getWhichCompiler
+  ,getCompilerPath
   -- * Details
   -- ** ApplyGhcOptions
   ,ApplyGhcOptions(..)
@@ -126,7 +127,7 @@ module Stack.Types.Config
 import           Control.Applicative
 import           Control.Arrow ((&&&))
 import           Control.Exception
-import           Control.Monad (liftM, mzero, forM)
+import           Control.Monad (liftM, mzero, forM, join)
 import           Control.Monad.Catch (MonadThrow, throwM)
 import           Control.Monad.Logger (LogLevel(..))
 import           Control.Monad.Reader (MonadReader, ask, asks, MonadIO, liftIO)
@@ -174,7 +175,7 @@ import           Stack.Types.PackageName
 import           Stack.Types.TemplateName
 import           Stack.Types.Version
 import           System.PosixCompat.Types (UserID, GroupID, FileMode)
-import           System.Process.Read (EnvOverride)
+import           System.Process.Read (EnvOverride, findExecutable)
 
 -- Re-exports
 import          Stack.Types.Config.Build as X
@@ -1413,6 +1414,19 @@ minimalEnvSettings =
 getWhichCompiler :: (MonadReader env m, HasEnvConfig env) => m WhichCompiler
 getWhichCompiler = asks (whichCompiler . envConfigCompilerVersion . getEnvConfig)
 
+-- | Get the path for the given compiler ignoring any local binaries.
+--
+-- https://github.com/commercialhaskell/stack/issues/1052
+getCompilerPath
+    :: (MonadIO m, MonadThrow m, MonadReader env m, HasConfig env)
+    => WhichCompiler
+    -> m (Path Abs File)
+getCompilerPath wc = do
+    config <- asks getConfig
+    eoWithoutLocals <- liftIO $
+        configEnvOverride config minimalEnvSettings { esLocaleUtf8 = True }
+    join (findExecutable eoWithoutLocals (compilerExeName wc))
+
 data ProjectAndConfigMonoid
   = ProjectAndConfigMonoid !Project !ConfigMonoid
 

src/main/Main.hs

@@ -536,6 +536,7 @@ pathCmd keys go =
             localroot <- installationRootLocal
             distDir <- distRelativeDir
             hpcDir <- hpcReportDir
+            compilerPath <- getCompilerPath =<< getWhichCompiler
             forM_
                 -- filter the chosen paths in flags (keys),
                 -- or show all of them if no specific paths chosen.
@@ -561,20 +562,22 @@ pathCmd keys go =
                                     localroot
                                     distDir
                                     hpcDir
-                                    extra))))
+                                    extra
+                                    compilerPath))))
 
 -- | Passed to all the path printers as a source of info.
 data PathInfo = PathInfo
-    { piBuildConfig :: BuildConfig
-    , piEnvOverride :: EnvOverride
-    , piSnapDb      :: Path Abs Dir
-    , piLocalDb     :: Path Abs Dir
-    , piGlobalDb    :: Path Abs Dir
-    , piSnapRoot    :: Path Abs Dir
-    , piLocalRoot   :: Path Abs Dir
-    , piDistDir     :: Path Rel Dir
-    , piHpcDir      :: Path Abs Dir
-    , piExtraDbs    :: [Path Abs Dir]
+    { piBuildConfig  :: BuildConfig
+    , piEnvOverride  :: EnvOverride
+    , piSnapDb       :: Path Abs Dir
+    , piLocalDb      :: Path Abs Dir
+    , piGlobalDb     :: Path Abs Dir
+    , piSnapRoot     :: Path Abs Dir
+    , piLocalRoot    :: Path Abs Dir
+    , piDistDir      :: Path Rel Dir
+    , piHpcDir       :: Path Abs Dir
+    , piExtraDbs     :: [Path Abs Dir]
+    , piCompilerPath :: Path Abs File
     }
 
 -- | The paths of interest to a user. The first tuple string is used
@@ -600,6 +603,9 @@ paths =
     , ( "PATH environment variable"
       , "bin-path"
       , T.pack . intercalate [searchPathSeparator] . eoPath . piEnvOverride )
+    , ( "Compiler (e.g. ghc)"
+      , "compiler-path"
+      , T.pack . toFilePath . piCompilerPath )
     , ( "Local bin path where stack installs executables"
       , "local-bin-path"
       , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig )