Add field and flag for specifying compiler #1190

src/Stack/Config.hs

@@ -295,8 +295,9 @@ loadBuildConfig :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader env m, H
                 => Maybe (Project, Path Abs File, ConfigMonoid)
                 -> Config
                 -> Maybe AbstractResolver -- override resolver
+                -> Maybe CompilerVersion -- override compiler
                 -> m BuildConfig
-loadBuildConfig mproject config mresolver = do
+loadBuildConfig mproject config mresolver mcompiler = do
     env <- ask
     miniConfig <- loadMiniConfig config
 
@@ -340,6 +341,7 @@ loadBuildConfig mproject config mresolver = do
                            , projectExtraDeps = mempty
                            , projectFlags = mempty
                            , projectResolver = r
+                           , projectCompiler = Nothing
                            , projectExtraPackageDBs = []
                            }
                    liftIO $ do
@@ -362,17 +364,22 @@ loadBuildConfig mproject config mresolver = do
             Nothing -> return $ projectResolver project'
             Just aresolver -> do
                 runReaderT (makeConcreteResolver aresolver) miniConfig
-    let project = project' { projectResolver = resolver }
+    let project = project'
+            { projectResolver = resolver
+            , projectCompiler = mcompiler <|> projectCompiler project'
+            }
 
     wantedCompiler <-
-        case projectResolver project of
-            ResolverSnapshot snapName -> do
-                mbp <- runReaderT (loadMiniBuildPlan snapName) miniConfig
-                return $ mbpCompilerVersion mbp
-            ResolverCustom _name url -> do
-                mbp <- runReaderT (parseCustomMiniBuildPlan stackYamlFP url) miniConfig
-                return $ mbpCompilerVersion mbp
-            ResolverCompiler wantedCompiler -> return wantedCompiler
+        case projectCompiler project of
+            Just wantedCompiler -> return wantedCompiler
+            Nothing -> case projectResolver project of
+                ResolverSnapshot snapName -> do
+                    mbp <- runReaderT (loadMiniBuildPlan snapName) miniConfig
+                    return $ mbpCompilerVersion mbp
+                ResolverCustom _name url -> do
+                    mbp <- runReaderT (parseCustomMiniBuildPlan stackYamlFP url) miniConfig
+                    return $ mbpCompilerVersion mbp
+                ResolverCompiler wantedCompiler -> return wantedCompiler
 
     extraPackageDBs <- mapM parseRelAsAbsDir (projectExtraPackageDBs project)
 

src/Stack/Init.hs

@@ -94,6 +94,7 @@ initProject currDir initOpts = do
             , projectExtraDeps = extraDeps
             , projectFlags = flags
             , projectResolver = r
+            , projectCompiler = Nothing
             , projectExtraPackageDBs = []
             }
         pkgs = map toPkg cabalfps

src/Stack/Options.hs

@@ -16,7 +16,6 @@ module Stack.Options
     ,newOptsParser
     ,logLevelOptsParser
     ,ghciOptsParser
-    ,abstractResolverOptsParser
     ,solverOptsParser
     ,testOptsParser
     ,hpcReportOptsParser
@@ -532,6 +531,7 @@ globalOptsParser defaultTerminal =
     logLevelOptsParser <*>
     configOptsParser False <*>
     optional abstractResolverOptsParser <*>
+    optional compilerOptsParser <*>
     flag
         defaultTerminal
         False
@@ -623,6 +623,20 @@ readAbstractResolver = do
                 Left e -> readerError $ show e
                 Right x -> return $ ARResolver x
 
+compilerOptsParser :: Parser CompilerVersion
+compilerOptsParser =
+    option readCompilerVersion
+        (long "compiler" <>
+         metavar "COMPILER" <>
+         help "Use the specified compiler")
+
+readCompilerVersion :: ReadM CompilerVersion
+readCompilerVersion = do
+    s <- readerAsk
+    case parseCompilerVersion (T.pack s) of
+        Nothing -> readerError $ "Failed to parse compiler: " ++ s
+        Just x -> return x
+
 -- | GHC variant parser
 ghcVariantParser :: Parser GHCVariant
 ghcVariantParser =

src/Stack/Setup.hs

@@ -984,7 +984,7 @@ loadGhcjsEnvConfig stackYaml binPath = runInnerStackLoggingT $ do
             , configMonoidLocalBinPath = Just (toFilePath binPath)
             })
         (Just stackYaml)
-    bconfig <- lcLoadBuildConfig lc Nothing
+    bconfig <- lcLoadBuildConfig lc Nothing Nothing
     runInnerStackT bconfig $ setupEnv Nothing
 
 getCabalInstallVersion :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadCatch m)

src/Stack/Types/Config.hs

@@ -275,6 +275,7 @@ data GlobalOpts = GlobalOpts
     , globalLogLevel     :: !LogLevel -- ^ Log level
     , globalConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'
     , globalResolver     :: !(Maybe AbstractResolver) -- ^ Resolver override
+    , globalCompiler     :: !(Maybe CompilerVersion) -- ^ Compiler override
     , globalTerminal     :: !Bool -- ^ We're in a terminal?
     , globalStackYaml    :: !(Maybe FilePath) -- ^ Override project stack.yaml
     } deriving (Show)
@@ -356,7 +357,7 @@ instance HasEnvConfig EnvConfig where
 data LoadConfig m = LoadConfig
     { lcConfig          :: !Config
       -- ^ Top-level Stack configuration.
-    , lcLoadBuildConfig :: !(Maybe AbstractResolver -> m BuildConfig)
+    , lcLoadBuildConfig :: !(Maybe AbstractResolver -> Maybe CompilerVersion -> m BuildConfig)
         -- ^ Action to load the remaining 'BuildConfig'.
     , lcProjectRoot     :: !(Maybe (Path Abs Dir))
         -- ^ The project root directory, if in a project.
@@ -448,12 +449,15 @@ data Project = Project
     -- ^ Per-package flag overrides
     , projectResolver :: !Resolver
     -- ^ How we resolve which dependencies to use
+    , projectCompiler :: !(Maybe CompilerVersion)
+    -- ^ When specified, overrides which compiler to use
     , projectExtraPackageDBs :: ![FilePath]
     }
   deriving Show
 
 instance ToJSON Project where
-    toJSON p = object
+    toJSON p = object $
+        (maybe id (\cv -> (("compiler" .= cv) :)) (projectCompiler p))
         [ "packages"          .= projectPackages p
         , "extra-deps"        .= map fromTuple (Map.toList $ projectExtraDeps p)
         , "flags"             .= projectFlags p
@@ -1079,13 +1083,15 @@ instance (warnings ~ [JSONWarning]) => FromJSON (ProjectAndConfigMonoid, warning
 
         flags <- o ..:? "flags" ..!= mempty
         resolver <- jsonSubWarnings (o ..: "resolver")
+        compiler <- o ..:? "compiler"
         config <- parseConfigMonoidJSON o
         extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
         let project = Project
                 { projectPackages = dirs
                 , projectExtraDeps = extraDeps
                 , projectFlags = flags
                 , projectResolver = resolver
+                , projectCompiler = compiler
                 , projectExtraPackageDBs = extraPackageDBs
                 }
         return $ ProjectAndConfigMonoid project config

src/Stack/Upgrade.hs

@@ -88,7 +88,7 @@ upgrade gitRepo mresolver = withCanonicalizedSystemTempDirectory "stack-upgrade"
                     { configMonoidInstallGHC = Just True
                     })
                 (Just $ dir </> $(mkRelFile "stack.yaml"))
-            lcLoadBuildConfig lc mresolver
+            lcLoadBuildConfig lc mresolver Nothing
         envConfig1 <- runInnerStackT bconfig $ setupEnv $ Just $
             "Try rerunning with --install-ghc to install the correct GHC into " <>
             T.pack (toFilePath (configLocalPrograms config))

src/main/Main.hs

@@ -545,7 +545,7 @@ setupCmd SetupCmdOpts{..} go@GlobalOpts{..} = do
                   case scoCompilerVersion of
                       Just v -> return (v, MatchMinor, Nothing)
                       Nothing -> do
-                          bc <- lcLoadBuildConfig lc globalResolver
+                          bc <- lcLoadBuildConfig lc globalResolver globalCompiler
                           return ( bcWantedCompiler bc
                                  , configCompilerCheck (lcConfig lc)
                                  , Just $ bcStackYaml bc
@@ -690,7 +690,7 @@ withBuildConfigExt go@GlobalOpts{..} mbefore inner mafter = do
 
       let inner'' lk = do
               bconfig <- runStackLoggingTGlobal manager go $
-                  lcLoadBuildConfig lc globalResolver
+                  lcLoadBuildConfig lc globalResolver globalCompiler
               envConfig <-
                  runStackTGlobal
                      manager bconfig go

src/test/Stack/BuildPlanSpec.hs

@@ -54,7 +54,7 @@ spec = beforeAll setup $ afterAll teardown $ do
         -- github still depends on failure.
         writeFile "stack.yaml" "resolver: lts-2.9"
         LoadConfig{..} <- loadConfig' manager
-        bconfig <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing)
+        bconfig <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing Nothing)
         runStackT manager logLevel bconfig False False $ do
             menv <- getMinimalEnvOverride
             mbp <- loadMiniBuildPlan $ LTS 2 9

src/test/Stack/ConfigSpec.hs

@@ -82,7 +82,7 @@ spec = beforeAll setup $ afterAll teardown $ do
       setCurrentDirectory childDir
       LoadConfig{..} <- loadConfig' manager
       bc@BuildConfig{..} <- loadBuildConfigRest manager
-                            (lcLoadBuildConfig Nothing)
+                            (lcLoadBuildConfig Nothing Nothing)
       bcRoot bc `shouldBe` parentDir
 
     it "respects the STACK_YAML env variable" $ \T{..} -> inTempDir $ do
@@ -92,7 +92,7 @@ spec = beforeAll setup $ afterAll teardown $ do
         withEnvVar "STACK_YAML" stackYamlFp $ do
           LoadConfig{..} <- loadConfig' manager
           BuildConfig{..} <- loadBuildConfigRest manager
-                                (lcLoadBuildConfig Nothing)
+                                (lcLoadBuildConfig Nothing Nothing)
           bcStackYaml `shouldBe` dir </> stackDotYaml
           parent bcStackYaml `shouldBe` dir
 
@@ -106,5 +106,5 @@ spec = beforeAll setup $ afterAll teardown $ do
         withEnvVar "STACK_YAML" (toFilePath yamlRel) $ do
             LoadConfig{..} <- loadConfig' manager
             BuildConfig{..} <- loadBuildConfigRest manager
-                                (lcLoadBuildConfig Nothing)
+                                (lcLoadBuildConfig Nothing Nothing)
             bcStackYaml `shouldBe` yamlAbs