Merge pull request commercialhaskell#2016 from sjakobi/1546-ghc-path

mgsloan · mgsloan · commit 2e7e684f7407 · 2016-04-11T15:21:43.000-07:00
stack path: Rename --ghc-paths to --programs-path, add --compiler-path commercialhaskell#1546
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -13,6 +13,9 @@ 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`.
+* The `stack path --ghc-paths` option is renamed to `--programs-path`.
+  `--compiler-path` is added, which points directly at the compiler used in
+  the current project.
 
 Other enhancements:
 
diff --git a/doc/GUIDE.md b/doc/GUIDE.md
@@ -1473,7 +1473,8 @@ 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
+programs-path: /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:
@@ -1491,7 +1492,7 @@ 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:
 
 ```
-michael@d30748af6d3d:~/wai$ ls $(stack path --ghc-paths)/*.installed
+michael@d30748af6d3d:~/wai$ ls $(stack path --programs-path)/*.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
 ```
@@ -1504,7 +1505,7 @@ what needs to be removed:
 1. The stack executable itself
 2. The stack root, e.g. `$HOME/.stack` on non-Windows systems.
     * See `stack path --global-stack-root`
-    * On Windows, you will also need to delete `stack path --ghc-paths`
+    * On Windows, you will also need to delete `stack path --programs-paths`
 3. Any local `.stack-work` directories inside a project
 
 ## exec
diff --git a/src/Stack/Build/Execute.hs b/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
diff --git a/src/Stack/Types/Config.hs b/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
 
diff --git a/src/main/Main.hs b/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,9 +603,12 @@ paths =
     , ( "PATH environment variable"
       , "bin-path"
       , T.pack . intercalate [searchPathSeparator] . eoPath . piEnvOverride )
-    , ( "Installed GHCs (unpacked and archives)"
-      , "ghc-paths"
+    , ( "Install location for GHC and other core tools"
+      , "programs-path"
       , T.pack . toFilePathNoTrailingSep . configLocalPrograms . bcConfig . piBuildConfig )
+    , ( "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 )
