init: use global --resolver option

stack init now uses the global --resolver option instead of its own
implementation of the same.

This changes the CLI behavior: you will have to use
`stack --resolver lts-4.1 init` instead of `stack init --resolver lts-4.1`

Fixes commercialhaskell#1588

src/Stack/Init.hs

@@ -5,7 +5,6 @@
 module Stack.Init
     ( initProject
     , InitOpts (..)
-    , Method (..)
     ) where
 
 import           Control.Exception               (assert)
@@ -52,8 +51,9 @@ initProject
        , HasTerminal env)
     => Path Abs Dir
     -> InitOpts
+    -> Maybe AbstractResolver
     -> m ()
-initProject currDir initOpts = do
+initProject currDir initOpts mresolver = do
     let dest = currDir </> stackDotYaml
         dest' = toFilePath dest
 
@@ -71,7 +71,8 @@ initProject currDir initOpts = do
     cabalfps <- findCabalFiles (includeSubDirs initOpts) currDir
     (bundle, dupPkgs)  <- cabalPackagesCheck cabalfps noPkgMsg Nothing
 
-    (r, flags, extraDeps, rbundle) <- getDefaultResolver dest initOpts bundle
+    (r, flags, extraDeps, rbundle) <- getDefaultResolver dest initOpts
+                                                         mresolver bundle
 
     let ignored = Map.difference bundle rbundle
         dupPkgMsg
@@ -261,6 +262,7 @@ getDefaultResolver
        , HasTerminal env)
     => Path Abs File   -- ^ stack.yaml
     -> InitOpts
+    -> Maybe AbstractResolver
     -> Map PackageName (Path Abs File, C.GenericPackageDescription)
        -- ^ Src package name: cabal dir, cabal package description
     -> m ( Resolver
@@ -271,14 +273,11 @@ getDefaultResolver
        --   , Flags for src packages and extra deps
        --   , Extra dependencies
        --   , Src packages actually considered)
-getDefaultResolver stackYaml initOpts bundle =
-    getResolver (ioMethod initOpts)
+getDefaultResolver stackYaml initOpts mresolver bundle =
+    maybe selectSnapResolver makeConcreteResolver mresolver
       >>= getWorkingResolverPlan stackYaml initOpts bundle
     where
         -- TODO support selecting best across regular and custom snapshots
-        getResolver (MethodAutoSelect) = selectSnapResolver
-        getResolver (MethodResolver aresolver) = makeConcreteResolver aresolver
-
         selectSnapResolver = do
             let gpds = Map.elems (fmap snd bundle)
             snaps <- getSnapshots' >>= getRecommendedSnapshots
@@ -430,17 +429,12 @@ getRecommendedSnapshots snapshots = do
         ]
 
 data InitOpts = InitOpts
-    { ioMethod       :: !Method
+    { useSolver :: Bool
     -- ^ Use solver
-    , useSolver :: Bool
-    -- ^ Preferred snapshots
     , omitPackages :: Bool
     -- ^ Exclude conflicting or incompatible user packages
     , forceOverwrite :: Bool
     -- ^ Overwrite existing files
     , includeSubDirs :: Bool
     -- ^ If True, include all .cabal files found in any sub directories
     }
-
--- | Method of initializing
-data Method = MethodAutoSelect | MethodResolver AbstractResolver

src/Stack/Options.hs

@@ -670,7 +670,7 @@ globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts
 
 initOptsParser :: Parser InitOpts
 initOptsParser =
-    InitOpts <$> method <*> solver <*> omitPackages
+    InitOpts <$> solver <*> omitPackages
              <*> overwrite <*> fmap not ignoreSubDirs
   where
     ignoreSubDirs = switch (long "ignore-subdirs" <>
@@ -682,14 +682,6 @@ initOptsParser =
     solver = switch (long "solver" <>
              help "Use a dependency solver to determine extra dependencies")
 
-    method = (MethodResolver <$> resolver)
-         <|> (pure MethodAutoSelect)
-
-    resolver = option readAbstractResolver
-        (long "resolver" <>
-         metavar "RESOLVER" <>
-         help "Use the specified resolver")
-
 -- | Parser for a logging level.
 logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
 logLevelOptsParser hide defLogLevel =

src/main/Main.hs

@@ -1183,15 +1183,14 @@ withMiniConfigAndLock go inner =
 initCmd :: InitOpts -> GlobalOpts -> IO ()
 initCmd initOpts go = do
     pwd <- getWorkingDir
-    withMiniConfigAndLock go (initProject pwd initOpts)
+    withMiniConfigAndLock go (initProject pwd initOpts (globalResolver go))
 
 -- | Create a project directory structure and initialize the stack config.
 newCmd :: (NewOpts,InitOpts) -> GlobalOpts -> IO ()
 newCmd (newOpts,initOpts) go@GlobalOpts{..} = do
     withMiniConfigAndLock go $ do
         dir <- new newOpts
-        initProject dir initOpts
-
+        initProject dir initOpts globalResolver
 
 -- | List the available templates.
 templatesCmd :: () -> GlobalOpts -> IO ()