From 1020a2f7f82967c4701526115e4e7c431f573b4c Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Wed, 1 Feb 2017 14:36:24 -0800
Subject: [PATCH] Fix "stack config set" to work on local project #2709

---
 ChangeLog.md           |  3 +++
 src/Stack/Config.hs    |  1 +
 src/Stack/ConfigCmd.hs | 30 +++++++++++++++++++++++++-----
 src/main/Main.hs       |  2 +-
 4 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index d9420f63fc..d2861801e8 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -72,6 +72,9 @@ Bug fixes:
   like base. ([#2871](https://github.com/commercialhaskell/stack/issues/2871))
 * `stack setup` now correctly indicates when it uses system ghc
   ([#2963](https://github.com/commercialhaskell/stack/issues/2963))
+* Fix to `stack config set`, in 1.3.2 it always applied to
+  the global project.
+  ([#2709](https://github.com/commercialhaskell/stack/issues/2709))
 
 ## 1.3.2
 
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
index 20f5943ead..ca2a784407 100644
--- a/src/Stack/Config.hs
+++ b/src/Stack/Config.hs
@@ -38,6 +38,7 @@ module Stack.Config
   ,getInContainer
   ,getInNixShell
   ,defaultConfigYaml
+  ,getProjectConfig
   ) where
 
 import qualified Codec.Archive.Tar as Tar
diff --git a/src/Stack/ConfigCmd.hs b/src/Stack/ConfigCmd.hs
index e8c4d5d9f6..30e4c132a3 100644
--- a/src/Stack/ConfigCmd.hs
+++ b/src/Stack/ConfigCmd.hs
@@ -14,6 +14,7 @@ module Stack.ConfigCmd
        ,cfgCmdName) where
 
 import           Control.Applicative
+import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Catch (throwM)
 import           Control.Monad.IO.Class
@@ -23,13 +24,15 @@ import qualified Data.HashMap.Strict as HMap
 import           Data.Monoid
 import           Data.Text (Text)
 import qualified Data.Text as T
+import           Data.Typeable
 import qualified Data.Yaml as Yaml
 import qualified Options.Applicative as OA
 import qualified Options.Applicative.Types as OA
 import           Path
+import           Path.IO
 import           Prelude -- Silence redundant import warnings
 import           Stack.BuildPlan
-import           Stack.Config (makeConcreteResolver, getStackYaml)
+import           Stack.Config (makeConcreteResolver, getProjectConfig)
 import           Stack.Types.Config
 import           Stack.Types.Resolver
 
@@ -46,6 +49,16 @@ data CommandScope
       --   typically at @~/.stack/config.yaml@.
     | CommandScopeProject
       -- ^ Apply changes to the project @stack.yaml@.
+    deriving (Show)
+
+data ConfigCmdError
+    = ExpectedLocalProject
+    deriving (Typeable)
+
+instance Exception ConfigCmdError
+instance Show ConfigCmdError where
+    show ExpectedLocalProject =
+        "Since --global was not used, expected to find a local project configuration.  However, none was found."
 
 configCmdSetScope :: ConfigCmdSet -> CommandScope
 configCmdSetScope (ConfigCmdSetResolver _) = CommandScopeProject
@@ -54,14 +67,21 @@ configCmdSetScope (ConfigCmdSetInstallGhc scope _) = scope
 
 cfgCmdSet
     :: (StackMiniM env m, HasConfig env, HasGHCVariant env)
-    => ConfigCmdSet -> m ()
-cfgCmdSet cmd = do
+    => GlobalOpts -> ConfigCmdSet -> m ()
+cfgCmdSet go cmd = do
+    conf <- view configL
     configFilePath <-
         liftM
             toFilePath
             (case configCmdSetScope cmd of
-                 CommandScopeProject -> getStackYaml
-                 CommandScopeGlobal -> view $ configL.to configUserConfigPath)
+                 CommandScopeProject -> do
+                     mstackYamlOption <- forM (globalStackYaml go) resolveFile'
+                     mstackYaml <- getProjectConfig mstackYamlOption
+                     case mstackYaml of
+                         Just stackYaml -> return stackYaml
+                         Nothing -> throwM ExpectedLocalProject
+                 CommandScopeGlobal -> return (configUserConfigPath conf))
+    liftIO $ print (configCmdSetScope cmd, configFilePath)
     -- We don't need to worry about checking for a valid yaml here
     (config :: Yaml.Object) <-
         liftIO (Yaml.decodeFileEither configFilePath) >>= either throwM return
diff --git a/src/main/Main.hs b/src/main/Main.hs
index 0f4e62541f..b0c473a478 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -857,7 +857,7 @@ cfgSetCmd :: ConfigCmd.ConfigCmdSet -> GlobalOpts -> IO ()
 cfgSetCmd co go@GlobalOpts{..} =
     withMiniConfigAndLock
         go
-        (cfgCmdSet co)
+        (cfgCmdSet go co)
 
 imgDockerCmd :: (Bool, [Text]) -> GlobalOpts -> IO ()
 imgDockerCmd (rebuild,images) go@GlobalOpts{..} = do