module Stack.ConfigCmd
(ConfigCmdSet(..)
,configCmdSetParser
,cfgCmdSet
,cfgCmdSetName
,cfgCmdName) where
import Control.Applicative
import Control.Monad
import Control.Monad.Catch (throwM)
import Control.Monad.IO.Class
import Control.Monad.Logger
import qualified Data.ByteString as S
import qualified Data.HashMap.Strict as HMap
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
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
import Stack.BuildPlan
import Stack.Config (makeConcreteResolver, getProjectConfig, getImplicitGlobalProjectDir, LocalConfigStatus(..))
import Stack.Constants
import Stack.Types.Config
import Stack.Types.Resolver
data ConfigCmdSet
= ConfigCmdSetResolver AbstractResolver
| ConfigCmdSetSystemGhc CommandScope
Bool
| ConfigCmdSetInstallGhc CommandScope
Bool
data CommandScope
= CommandScopeGlobal
| CommandScopeProject
configCmdSetScope :: ConfigCmdSet -> CommandScope
configCmdSetScope (ConfigCmdSetResolver _) = CommandScopeProject
configCmdSetScope (ConfigCmdSetSystemGhc scope _) = scope
configCmdSetScope (ConfigCmdSetInstallGhc scope _) = scope
cfgCmdSet
:: (StackMiniM env m, HasConfig env, HasGHCVariant env)
=> GlobalOpts -> ConfigCmdSet -> m ()
cfgCmdSet go cmd = do
conf <- view configL
configFilePath <-
liftM
toFilePath
(case configCmdSetScope cmd of
CommandScopeProject -> do
mstackYamlOption <- forM (globalStackYaml go) resolveFile'
mstackYaml <- getProjectConfig mstackYamlOption
case mstackYaml of
LCSProject stackYaml -> return stackYaml
LCSNoProject -> liftM (</> stackDotYaml) (getImplicitGlobalProjectDir conf)
LCSNoConfig -> error "config command used when no local configuration available"
CommandScopeGlobal -> return (configUserConfigPath conf))
(config :: Yaml.Object) <-
liftIO (Yaml.decodeFileEither configFilePath) >>= either throwM return
newValue <- cfgCmdSetValue cmd
let cmdKey = cfgCmdSetOptionName cmd
config' = HMap.insert cmdKey newValue config
if config' == config
then $logInfo
(T.pack configFilePath <>
" already contained the intended configuration and remains unchanged.")
else do
liftIO (S.writeFile configFilePath (Yaml.encode config'))
$logInfo (T.pack configFilePath <> " has been updated.")
cfgCmdSetValue
:: (StackMiniM env m, HasConfig env, HasGHCVariant env)
=> ConfigCmdSet -> m Yaml.Value
cfgCmdSetValue (ConfigCmdSetResolver newResolver) = do
concreteResolver <- makeConcreteResolver newResolver
case concreteResolver of
ResolverSnapshot snapName -> void $ loadMiniBuildPlan snapName
ResolverCompiler _ -> return ()
ResolverCustom _ _ -> error "'stack config set resolver' does not support custom resolvers"
return (Yaml.String (resolverName concreteResolver))
cfgCmdSetValue (ConfigCmdSetSystemGhc _ bool) =
return (Yaml.Bool bool)
cfgCmdSetValue (ConfigCmdSetInstallGhc _ bool) =
return (Yaml.Bool bool)
cfgCmdSetOptionName :: ConfigCmdSet -> Text
cfgCmdSetOptionName (ConfigCmdSetResolver _) = "resolver"
cfgCmdSetOptionName (ConfigCmdSetSystemGhc _ _) = configMonoidSystemGHCName
cfgCmdSetOptionName (ConfigCmdSetInstallGhc _ _) = configMonoidInstallGHCName
cfgCmdName :: String
cfgCmdName = "config"
cfgCmdSetName :: String
cfgCmdSetName = "set"
configCmdSetParser :: OA.Parser ConfigCmdSet
configCmdSetParser =
OA.hsubparser $
mconcat
[ OA.command
"resolver"
(OA.info
(ConfigCmdSetResolver <$>
OA.argument
readAbstractResolver
(OA.metavar "RESOLVER" <>
OA.help "E.g. \"nightly\" or \"lts-7.2\""))
(OA.progDesc
"Change the resolver of the current project. See https://docs.haskellstack.org/en/stable/yaml_configuration/#resolver for more info."))
, OA.command
(T.unpack configMonoidSystemGHCName)
(OA.info
(ConfigCmdSetSystemGhc <$> scopeFlag <*> boolArgument)
(OA.progDesc
"Configure whether stack should use a system GHC installation or not."))
, OA.command
(T.unpack configMonoidInstallGHCName)
(OA.info
(ConfigCmdSetInstallGhc <$> scopeFlag <*> boolArgument)
(OA.progDesc
"Configure whether stack should automatically install GHC when necessary."))
]
scopeFlag :: OA.Parser CommandScope
scopeFlag =
OA.flag
CommandScopeProject
CommandScopeGlobal
(OA.long "global" <>
OA.help
"Modify the global configuration (typically at \"~/.stack/config.yaml\") instead of the project stack.yaml.")
readBool :: OA.ReadM Bool
readBool = do
s <- OA.readerAsk
case s of
"true" -> return True
"false" -> return False
_ -> OA.readerError ("Invalid value " ++ show s ++ ": Expected \"true\" or \"false\"")
boolArgument :: OA.Parser Bool
boolArgument = OA.argument readBool (OA.metavar "true/false")