Browse Source

--resolver (closes #224)

137-stack-new
Michael Snoyman 7 years ago
parent
commit
83cad945b0
  1. 1
      ChangeLog.md
  2. 17
      src/Stack/Config.hs
  3. 2
      src/Stack/Types/Config.hs
  4. 22
      src/main/Main.hs

1
ChangeLog.md

@ -3,6 +3,7 @@
* `--prefetch` [#297](https://github.com/commercialhaskell/stack/issues/297)
* `upload` command ported from stackage-upload [#225](https://github.com/commercialhaskell/stack/issues/225)
* `--only-snapshot` [#310](https://github.com/commercialhaskell/stack/issues/310)
* `--resolver` [#224](https://github.com/commercialhaskell/stack/issues/224)
## 0.0.2

17
src/Stack/Config.hs

@ -335,12 +335,13 @@ loadBuildConfig :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader env m, H
-> Maybe (Project, Path Abs File, ConfigMonoid)
-> Config
-> Path Abs Dir
-> Maybe Resolver -- override resolver
-> NoBuildConfigStrategy
-> m BuildConfig
loadBuildConfig menv mproject config stackRoot noConfigStrat = do
loadBuildConfig menv mproject config stackRoot mresolver noConfigStrat = do
env <- ask
let miniConfig = MiniConfig (getHttpManager env) config
(project, stackYamlFP) <- case mproject of
(project', stackYamlFP) <- case mproject of
Just (project, fp, _) -> return (project, fp)
Nothing -> case noConfigStrat of
ThrowException -> do
@ -359,8 +360,13 @@ loadBuildConfig menv mproject config stackRoot noConfigStrat = do
inTerminal <- liftIO (hIsTerminalDevice stdout)
ProjectAndConfigMonoid project _ <- loadYaml dest
when inTerminal $ do
$logInfo ("Using resolver: " <> renderResolver (projectResolver project) <>
" from global config file: " <> T.pack dest')
case mresolver of
Nothing ->
$logInfo ("Using resolver: " <> renderResolver (projectResolver project) <>
" from global config file: " <> T.pack dest')
Just resolver ->
$logInfo ("Using resolver: " <> renderResolver resolver <>
" specified on command line")
return (project, dest)
else do
r <- runReaderT getLatestResolver miniConfig
@ -391,6 +397,9 @@ loadBuildConfig menv mproject config stackRoot noConfigStrat = do
}
liftIO $ Yaml.encodeFile dest' p
return (p, dest)
let project = project'
{ projectResolver = fromMaybe (projectResolver project') mresolver
}
ghcVersion <-
case projectResolver project of

2
src/Stack/Types/Config.hs

@ -201,7 +201,7 @@ instance HasEnvConfig EnvConfig where
data LoadConfig m = LoadConfig
{ lcConfig :: !Config
-- ^ Top-level Stack configuration.
, lcLoadBuildConfig :: !(NoBuildConfigStrategy -> m BuildConfig)
, lcLoadBuildConfig :: !(Maybe Resolver -> NoBuildConfigStrategy -> m BuildConfig)
-- ^ Action to load the remaining 'BuildConfig'.
, lcProjectRoot :: !(Maybe (Path Abs Dir))
-- ^ The project root directory, if in a project.

22
src/main/Main.hs

@ -191,7 +191,8 @@ main =
pathCmd :: PathArg -> GlobalOpts -> IO ()
pathCmd pathArg go@GlobalOpts{..} = do
(manager,lc) <- loadConfigWithOpts go
buildConfig <- runStackLoggingT manager globalLogLevel (lcLoadBuildConfig lc ExecStrategy)
buildConfig <- runStackLoggingT manager globalLogLevel
(lcLoadBuildConfig lc globalResolver ExecStrategy)
runStackT manager globalLogLevel buildConfig (pathString pathArg) >>= putStrLn
@ -250,7 +251,7 @@ setupCmd SetupCmdOpts{..} go@GlobalOpts{..} = do
case scoGhcVersion of
Just v -> return (v, Nothing)
Nothing -> do
bc <- lcLoadBuildConfig lc ThrowException
bc <- lcLoadBuildConfig lc globalResolver ThrowException
return (bcGhcVersion bc, Just $ bcStackYaml bc)
mpaths <- runStackT manager globalLogLevel (lcConfig lc) $ ensureGHC SetupOpts
{ soptsInstallIfMissing = True
@ -277,7 +278,7 @@ withBuildConfig go@GlobalOpts{..} strat inner = do
runStackLoggingT manager globalLogLevel $
Docker.rerunWithOptionalContainer (lcConfig lc) (lcProjectRoot lc) $ do
bconfig1 <- runStackLoggingT manager globalLogLevel $
lcLoadBuildConfig lc strat
lcLoadBuildConfig lc globalResolver strat
(bconfig2,cabalVer) <-
runStackT
manager globalLogLevel bconfig1
@ -515,6 +516,7 @@ globalOpts =
GlobalOpts
<$> logLevelOpt
<*> configOptsParser False
<*> optional resolverParser
-- | Parse for a logging level.
logLevelOpt :: Parser LogLevel
@ -543,6 +545,19 @@ logLevelOpt =
"error" -> LevelError
_ -> LevelOther (T.pack s)
resolverParser :: Parser Resolver
resolverParser =
option readResolver
(long "resolver" <>
metavar "RESOLVER" <>
help "Override resolver in project file")
where
readResolver = do
s <- readerAsk
case parseResolver $ T.pack s of
Left e -> readerError $ show e
Right x -> return x
-- | Default logging level should be something useful but not crazy.
defaultLogLevel :: LogLevel
defaultLogLevel = LevelInfo
@ -551,6 +566,7 @@ defaultLogLevel = LevelInfo
data GlobalOpts = GlobalOpts
{ globalLogLevel :: LogLevel -- ^ Log level
, globalConfigMonoid :: ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'
, globalResolver :: Maybe Resolver -- ^ Resolver override
} deriving (Show)
-- | Load the configuration with a manager. Convenience function used

Loading…
Cancel
Save