Have upgrade only use CLI and global conf #1392

src/Stack/Config.hs

@@ -243,8 +243,6 @@ configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject c
 
          configRequireStackVersion = simplifyVersionRange (getIntersectingVersionRange configMonoidRequireStackVersion)
 
-         configConfigMonoid = configMonoid
-
          configImage = Image.imgOptsFromMonoid configMonoidImageOpts
 
          configCompilerCheck = fromFirst MatchMinor configMonoidCompilerCheck

src/Stack/Types/Config.hs

@@ -286,8 +286,6 @@ data Config =
          -- ^ --extra-include-dirs arguments
          ,configExtraLibDirs        :: !(Set Text)
          -- ^ --extra-lib-dirs arguments
-         ,configConfigMonoid        :: !ConfigMonoid
-         -- ^ @ConfigMonoid@ used to generate this
          ,configConcurrentTests     :: !Bool
          -- ^ Run test suites concurrently
          ,configImage               :: !ImageOpts

src/Stack/Upgrade.hs

@@ -8,13 +8,12 @@ import           Control.Monad               (when)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
-import           Control.Monad.Reader        (MonadReader, asks)
+import           Control.Monad.Reader        (MonadReader)
 import           Control.Monad.Trans.Control
 import           Data.Foldable               (forM_)
 import qualified Data.Map                    as Map
 import           Data.Maybe                  (isNothing)
 import           Data.Monoid.Extra
-import qualified Data.Monoid
 import qualified Data.Text as T
 import           Lens.Micro                  (set)
 import           Network.HTTP.Client.Conduit (HasHttpManager)
@@ -33,11 +32,12 @@ import           System.Process              (readProcess)
 import           System.Process.Run
 
 upgrade :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m)
-        => Maybe String -- ^ git repository to use
+        => ConfigMonoid
+        -> Maybe String -- ^ git repository to use
         -> Maybe AbstractResolver
         -> Maybe String -- ^ git hash at time of building, if known
         -> m ()
-upgrade gitRepo mresolver builtHash =
+upgrade gConfigMonoid gitRepo mresolver builtHash =
   withSystemTempDir "stack-upgrade" $ \tmp -> do
     menv <- getMinimalEnvOverride
     mdir <- case gitRepo of
@@ -89,19 +89,15 @@ upgrade gitRepo mresolver builtHash =
                     Nothing -> error "Stack.Upgrade.upgrade: invariant violated, unpacked directory not found"
                     Just path -> return $ Just path
 
-    config <- asks getConfig
     forM_ mdir $ \dir -> do
-        bconfig <- runInnerStackLoggingT $ do
-            lc <- loadConfig
-                (configConfigMonoid config <> Data.Monoid.mempty
-                    { configMonoidInstallGHC = First (Just True)
-                    })
-                mresolver
-                (Just $ dir </> $(mkRelFile "stack.yaml"))
-            lcLoadBuildConfig lc Nothing
+        lc <- loadConfig
+            gConfigMonoid
+            mresolver
+            (Just $ dir </> $(mkRelFile "stack.yaml"))
+        bconfig <- lcLoadBuildConfig lc Nothing
         envConfig1 <- runInnerStackT bconfig $ setupEnv $ Just $
             "Try rerunning with --install-ghc to install the correct GHC into " <>
-            T.pack (toFilePath (configLocalPrograms config))
+            T.pack (toFilePath (configLocalPrograms (getConfig bconfig)))
         runInnerStackT (set (envConfigBuildOpts.buildOptsInstallExes) True envConfig1) $
             build (const $ return ()) Nothing defaultBuildOptsCLI
                 { boptsCLITargets = ["stack"]

src/main/Main.hs

@@ -827,31 +827,48 @@ withUserFileLock go@GlobalOpts{} dir act = do
                                             act $ Just lk))
         else act Nothing
 
-withConfigAndLock :: GlobalOpts
-           -> StackT Config IO ()
-           -> IO ()
+withConfigAndLock
+    :: GlobalOpts
+    -> StackT Config IO ()
+    -> IO ()
 withConfigAndLock go@GlobalOpts{..} inner = do
     (manager, lc) <- loadConfigWithOpts go
     withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk ->
-     runStackTGlobal manager (lcConfig lc) go $
-        Docker.reexecWithOptionalContainer (lcProjectRoot lc)
-            Nothing
-            (runStackTGlobal manager (lcConfig lc) go inner)
-            Nothing
-            (Just $ munlockFile lk)
+        runStackTGlobal manager (lcConfig lc) go $
+            Docker.reexecWithOptionalContainer
+                (lcProjectRoot lc)
+                Nothing
+                (runStackTGlobal manager (lcConfig lc) go inner)
+                Nothing
+                (Just $ munlockFile lk)
+
+-- | Loads global config, ignoring any configuration which would be
+-- loaded due to $PWD.
+withGlobalConfigAndLock
+    :: GlobalOpts
+    -> StackT Config IO ()
+    -> IO ()
+withGlobalConfigAndLock go@GlobalOpts{..} inner = do
+    manager <- newTLSManager
+    lc <- runStackLoggingTGlobal manager go $
+        loadConfigMaybeProject globalConfigMonoid Nothing Nothing
+    withUserFileLock go (configStackRoot $ lcConfig lc) $ \_lk ->
+        runStackTGlobal manager (lcConfig lc) go inner
 
 -- For now the non-locking version just unlocks immediately.
 -- That is, there's still a serialization point.
-withBuildConfig :: GlobalOpts
-               -> StackT EnvConfig IO ()
-               -> IO ()
+withBuildConfig
+    :: GlobalOpts
+    -> StackT EnvConfig IO ()
+    -> IO ()
 withBuildConfig go inner =
     withBuildConfigAndLock go (\lk -> do munlockFile lk
                                          inner)
 
-withBuildConfigAndLock :: GlobalOpts
-                 -> (Maybe FileLock -> StackT EnvConfig IO ())
-                 -> IO ()
+withBuildConfigAndLock
+    :: GlobalOpts
+    -> (Maybe FileLock -> StackT EnvConfig IO ())
+    -> IO ()
 withBuildConfigAndLock go inner =
     withBuildConfigExt go Nothing inner Nothing
 
@@ -956,8 +973,9 @@ updateCmd () go = withConfigAndLock go $
     getMinimalEnvOverride >>= Stack.PackageIndex.updateAllIndices
 
 upgradeCmd :: (Bool, String) -> GlobalOpts -> IO ()
-upgradeCmd (fromGit, repo) go = withConfigAndLock go $
-    upgrade (if fromGit then Just repo else Nothing)
+upgradeCmd (fromGit, repo) go = withGlobalConfigAndLock go $ do
+    upgrade (globalConfigMonoid go)
+            (if fromGit then Just repo else Nothing)
             (globalResolver go)
 #ifdef USE_GIT_INFO
             (find (/= "UNKNOWN") [$gitHash])