Skip to content

Commit

Permalink
Fix "stack config set" to work on local project #2709
Browse files Browse the repository at this point in the history
  • Loading branch information
mgsloan committed Feb 1, 2017
1 parent 069503e commit 1020a2f
Show file tree
Hide file tree
Showing 4 changed files with 30 additions and 6 deletions.
3 changes: 3 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
1 change: 1 addition & 0 deletions src/Stack/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ module Stack.Config
,getInContainer
,getInNixShell
,defaultConfigYaml
,getProjectConfig
) where

import qualified Codec.Archive.Tar as Tar
Expand Down
30 changes: 25 additions & 5 deletions src/Stack/ConfigCmd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/main/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 1020a2f

Please sign in to comment.