diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs
index 1b9e5ef1ef..7d13365ccf 100644
--- a/src/Stack/BuildPlan.hs
+++ b/src/Stack/BuildPlan.hs
@@ -10,17 +10,21 @@
 -- snapshot.
 
 module Stack.BuildPlan
-    ( BuildPlanException (..)
+    ( gpdPackages
+    , BuildPlanException (..)
+    , BuildPlanCheck (..)
+    , checkSnapBuildPlan
     , MiniBuildPlan(..)
     , MiniPackageInfo(..)
-    , Snapshots (..)
-    , getSnapshots
     , loadMiniBuildPlan
+    , removeSrcPkgDefaultFlags
     , resolveBuildPlan
-    , findBuildPlan
+    , selectBestSnapshot
     , ToolMap
     , getToolMap
     , shadowMiniBuildPlan
+    , showCompilerErrors
+    , showDepErrors
     , parseCustomMiniBuildPlan
     ) where
 
@@ -35,7 +39,7 @@ import           Control.Monad.State.Strict      (State, execState, get, modify,
                                                   put)
 import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Crypto.Hash.SHA256 as SHA256
-import           Data.Aeson.Extended (FromJSON (..), withObject, withText, (.:), (.:?), (.!=))
+import           Data.Aeson.Extended (FromJSON (..), withObject, (.:), (.:?), (.!=))
 import           Data.Binary.VersionTagged (taggedDecodeOrLoad)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as B16
@@ -43,20 +47,17 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import           Data.Either (partitionEithers)
 import qualified Data.Foldable as F
-import qualified Data.HashMap.Strict as HM
-import           Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
+import qualified Data.HashSet as HashSet
 import           Data.List (intercalate)
 import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Maybe (fromMaybe, mapMaybe)
+import           Data.Maybe (fromJust, fromMaybe, mapMaybe)
 import           Data.Monoid
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Text.Encoding (encodeUtf8)
-import           Data.Time (Day)
 import qualified Data.Traversable as Tr
 import           Data.Typeable (Typeable)
 import           Data.Yaml (decodeEither', decodeFileEither)
@@ -64,6 +65,7 @@ import           Distribution.PackageDescription (GenericPackageDescription,
                                                   flagDefault, flagManual,
                                                   flagName, genPackageFlags,
                                                   executables, exeName, library, libBuildInfo, buildable)
+import           Distribution.System (Platform)
 import qualified Distribution.Package as C
 import qualified Distribution.PackageDescription as C
 import qualified Distribution.Version as C
@@ -392,39 +394,6 @@ getToolMap mbp =
       $ Set.toList
       $ mpiExes mpi
 
--- | Download the 'Snapshots' value from stackage.org.
-getSnapshots :: (MonadThrow m, MonadIO m, MonadReader env m, HasHttpManager env, HasStackRoot env, HasConfig env)
-             => m Snapshots
-getSnapshots = askLatestSnapshotUrl >>= parseUrl . T.unpack >>= downloadJSON
-
--- | Most recent Nightly and newest LTS version per major release.
-data Snapshots = Snapshots
-    { snapshotsNightly :: !Day
-    , snapshotsLts     :: !(IntMap Int)
-    }
-    deriving Show
-instance FromJSON Snapshots where
-    parseJSON = withObject "Snapshots" $ \o -> Snapshots
-        <$> (o .: "nightly" >>= parseNightly)
-        <*> (fmap IntMap.unions
-                $ mapM (parseLTS . snd)
-                $ filter (isLTS . fst)
-                $ HM.toList o)
-      where
-        parseNightly t =
-            case parseSnapName t of
-                Left e -> fail $ show e
-                Right (LTS _ _) -> fail "Unexpected LTS value"
-                Right (Nightly d) -> return d
-
-        isLTS = ("lts-" `T.isPrefixOf`)
-
-        parseLTS = withText "LTS" $ \t ->
-            case parseSnapName t of
-                Left e -> fail $ show e
-                Right (LTS x y) -> return $ IntMap.singleton x y
-                Right (Nightly _) -> fail "Unexpected nightly value"
-
 -- | Load up a 'MiniBuildPlan', preferably from cache
 loadMiniBuildPlan
     :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, HasGHCVariant env, MonadBaseControl IO m, MonadCatch m)
@@ -494,67 +463,136 @@ loadBuildPlan name = do
     handle404 (Status 404 _) _ _ = Just $ SomeException $ SnapshotNotFound name
     handle404 _ _ _              = Nothing
 
--- | Find the set of @FlagName@s necessary to get the given
--- @GenericPackageDescription@ to compile against the given @BuildPlan@. Will
--- only modify non-manual flags, and will prefer default values for flags.
--- Returns @Nothing@ if no combination exists.
-checkBuildPlan :: (MonadLogger m, MonadThrow m, MonadIO m, MonadReader env m, HasConfig env, MonadCatch m)
-               => Map PackageName Version -- ^ locally available packages
-               -> MiniBuildPlan
-               -> GenericPackageDescription
-               -> m (Either DepErrors (Map PackageName (Map FlagName Bool)))
-checkBuildPlan locals mbp gpd = do
-    platform <- asks (configPlatform . getConfig)
-    return $ loop platform flagOptions
-  where
-    packages = Map.union locals $ fmap mpiVersion $ mbpPackages mbp
-    loop _ [] = assert False $ Left Map.empty
-    loop platform (flags:rest)
-        | Map.null errs = Right $
-            if Map.null flags
-                then Map.empty
-                else Map.singleton (packageName pkg) flags
-        | null rest = Left errs
-        | otherwise = loop platform rest
-      where
-        errs = checkDeps (packageName pkg) (packageDeps pkg) packages
-        pkg = resolvePackage pkgConfig gpd
+gpdPackages :: [GenericPackageDescription] -> Map PackageName Version
+gpdPackages gpds = Map.fromList $
+            map (fromCabalIdent . C.package . C.packageDescription) gpds
+    where
+        fromCabalIdent (C.PackageIdentifier name version) =
+            (fromCabalPackageName name, fromCabalVersion version)
+
+gpdPackageName :: GenericPackageDescription -> PackageName
+gpdPackageName = fromCabalPackageName
+    . C.pkgName
+    . C.package
+    . C.packageDescription
+
+gpdPackageDeps
+    :: GenericPackageDescription
+    -> CompilerVersion
+    -> Platform
+    -> Map FlagName Bool
+    -> Map PackageName VersionRange
+gpdPackageDeps gpd cv platform flags =
+    Map.filterWithKey (const . (/= name)) (packageDependencies pkgDesc)
+    where
+        name = gpdPackageName gpd
+        pkgDesc = resolvePackageDescription pkgConfig gpd
         pkgConfig = PackageConfig
             { packageConfigEnableTests = True
             , packageConfigEnableBenchmarks = True
             , packageConfigFlags = flags
-            , packageConfigCompilerVersion = compilerVersion
+            , packageConfigCompilerVersion = cv
             , packageConfigPlatform = platform
             }
 
-    compilerVersion = mbpCompilerVersion mbp
+-- Remove any src package flags having default values
+-- Remove any package entries with no flags set
+removeSrcPkgDefaultFlags :: [C.GenericPackageDescription]
+                         -> Map PackageName (Map FlagName Bool)
+                         -> Map PackageName (Map FlagName Bool)
+removeSrcPkgDefaultFlags gpds flags =
+    let defaults = Map.unions (map gpdDefaultFlags gpds)
+        flags'   = Map.differenceWith removeSame flags defaults
+    in  Map.filter (not . Map.null) flags'
+    where
+        removeSame f1 f2 =
+            let diff v v' = if v == v' then Nothing else Just v
+            in Just $ Map.differenceWith diff f1 f2
+
+        gpdDefaultFlags gpd =
+            let tuples = map getDefault (C.genPackageFlags gpd)
+            in Map.singleton (gpdPackageName gpd) (Map.fromList tuples)
+
+        flagName' = fromCabalFlagName . C.flagName
+        getDefault f
+            | C.flagDefault f = (flagName' f, True)
+            | otherwise       = (flagName' f, False)
 
-    flagName' = fromCabalFlagName . flagName
+-- | Find the set of @FlagName@s necessary to get the given
+-- @GenericPackageDescription@ to compile against the given @BuildPlan@. Will
+-- only modify non-manual flags, and will prefer default values for flags.
+-- Returns the plan which produces least number of dep errors
+selectPackageBuildPlan
+    :: Platform
+    -> CompilerVersion
+    -> Map PackageName Version
+    -> GenericPackageDescription
+    -> (Map PackageName (Map FlagName Bool), DepErrors)
+selectPackageBuildPlan platform compiler pool gpd =
+    fromJust (go flagOptions Nothing)
+    where
+        go :: [Map FlagName Bool] -> Maybe (Map PackageName (Map FlagName Bool), DepErrors) -> Maybe (Map PackageName (Map FlagName Bool), DepErrors)
+        -- impossible
+        go [] Nothing = assert False Nothing
+        -- last
+        go [] (Just plan) = Just plan
+        -- got the best possible result
+        go _ (Just plan) | Map.null (snd plan) = Just plan
+        -- initial
+        go (flags:rest) Nothing = go rest $ Just (nextPlan flags)
+        -- keep looking for better results
+        go (flags:rest) (Just plan) =
+          go rest $ Just (betterPlan plan (nextPlan flags))
+
+        nextPlan flags = checkPackageBuildPlan platform compiler pool flags gpd
+
+        betterPlan (f1, e1) (f2, e2)
+          | (Map.size e1) <= (Map.size e2) = (f1, e1)
+          | otherwise = (f2, e2)
+
+        flagName' = fromCabalFlagName . flagName
+
+        -- Avoid exponential complexity in flag combinations making us sad pandas.
+        -- See: https://github.com/commercialhaskell/stack/issues/543
+        maxFlagOptions = 128
+
+        flagOptions :: [Map FlagName Bool]
+        flagOptions = take maxFlagOptions $ map Map.fromList $ mapM getOptions $ genPackageFlags gpd
+        getOptions f
+            | flagManual f = [(flagName' f, flagDefault f)]
+            | flagDefault f =
+                [ (flagName' f, True)
+                , (flagName' f, False)
+                ]
+            | otherwise =
+                [ (flagName' f, False)
+                , (flagName' f, True)
+                ]
 
-    -- Avoid exponential complexity in flag combinations making us sad pandas.
-    -- See: https://github.com/commercialhaskell/stack/issues/543
-    maxFlagOptions = 128
-
-    flagOptions = take maxFlagOptions $ map Map.fromList $ mapM getOptions $ genPackageFlags gpd
-    getOptions f
-        | flagManual f = [(flagName' f, flagDefault f)]
-        | flagDefault f =
-            [ (flagName' f, True)
-            , (flagName' f, False)
-            ]
-        | otherwise =
-            [ (flagName' f, False)
-            , (flagName' f, True)
-            ]
+-- | Check whether with the given set of flags a package's dependency
+-- constraints can be satisfied against a given build plan or pool of packages.
+checkPackageBuildPlan
+    :: Platform
+    -> CompilerVersion
+    -> Map PackageName Version
+    -> Map FlagName Bool
+    -> GenericPackageDescription
+    -> (Map PackageName (Map FlagName Bool), DepErrors)
+checkPackageBuildPlan platform compiler pool flags gpd =
+    (Map.singleton pkg flags, errs)
+    where
+        pkg         = gpdPackageName gpd
+        errs        = checkPackageDeps pkg constraints pool
+        constraints = gpdPackageDeps gpd compiler platform flags
 
 -- | Checks if the given package dependencies can be satisfied by the given set
 -- of packages. Will fail if a package is either missing or has a version
 -- outside of the version range.
-checkDeps :: PackageName -- ^ package using dependencies, for constructing DepErrors
-          -> Map PackageName VersionRange
-          -> Map PackageName Version
+checkPackageDeps :: PackageName -- ^ package using dependencies, for constructing DepErrors
+          -> Map PackageName VersionRange -- ^ dependency constraints
+          -> Map PackageName Version -- ^ Available package pool or index
           -> DepErrors
-checkDeps myName deps packages =
+checkPackageDeps myName deps packages =
     Map.unionsWith mappend $ map go $ Map.toList deps
   where
     go :: (PackageName, VersionRange) -> DepErrors
@@ -575,47 +613,165 @@ type DepErrors = Map PackageName DepError
 data DepError = DepError
     { deVersion :: !(Maybe Version)
     , deNeededBy :: !(Map PackageName VersionRange)
-    }
+    } deriving Show
 instance Monoid DepError where
     mempty = DepError Nothing Map.empty
     mappend (DepError a x) (DepError b y) = DepError
         (maybe a Just b)
         (Map.unionWith C.intersectVersionRanges x y)
 
--- | Find a snapshot and set of flags that is compatible with the given
--- 'GenericPackageDescription'. Returns 'Nothing' if no such snapshot is found.
-findBuildPlan :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, HasGHCVariant env, MonadBaseControl IO m)
-              => [GenericPackageDescription]
-              -> [SnapName]
-              -> m (Maybe (SnapName, Map PackageName (Map FlagName Bool)))
-findBuildPlan gpds0 =
-    loop
-  where
-    loop [] = return Nothing
-    loop (name:names') = do
-        mbp <- loadMiniBuildPlan name
-        $logInfo $ "Checking against build plan " <> renderSnapName name
-        res <- mapM (checkBuildPlan localNames mbp) gpds0
-        case partitionEithers res of
-            ([], flags) -> return $ Just (name, Map.unions flags)
-            (errs, _) -> do
-                $logInfo ""
-                $logInfo "* Build plan did not match your requirements:"
-                displayDepErrors $ Map.unionsWith mappend errs
-                $logInfo ""
-                loop names'
-
-    localNames = Map.fromList $ map (fromCabalIdent . C.package . C.packageDescription) gpds0
-
-    fromCabalIdent (C.PackageIdentifier name version) =
-        (fromCabalPackageName name, fromCabalVersion version)
-
-displayDepErrors :: MonadLogger m => DepErrors -> m ()
-displayDepErrors errs =
-    F.forM_ (Map.toList errs) $ \(depName, DepError mversion neededBy) -> do
-        $logInfo $ T.concat
-            [ "    "
-            , T.pack $ packageNameString depName
+-- | Given a bundle of packages (a list of @GenericPackageDescriptions@'s) to
+-- build and an available package pool (snapshot) check whether the bundle's
+-- dependencies can be satisfied. If flags is passed as Nothing flag settings
+-- will be chosen automatically.
+checkBundleBuildPlan
+    :: Platform
+    -> CompilerVersion
+    -> Map PackageName Version
+    -> Maybe (Map PackageName (Map FlagName Bool))
+    -> [GenericPackageDescription]
+    -> (Map PackageName (Map FlagName Bool), DepErrors)
+checkBundleBuildPlan platform compiler pool flags gpds =
+    (Map.unionsWith dupError (map fst plans)
+    , Map.unionsWith mappend (map snd plans))
+
+    where
+        plans = map (pkgPlan flags) gpds
+        pkgPlan Nothing gpd =
+            selectPackageBuildPlan platform compiler pool' gpd
+        pkgPlan (Just f) gpd =
+            checkPackageBuildPlan platform compiler pool' (flags' f gpd) gpd
+        flags' f gpd = maybe Map.empty id (Map.lookup (gpdPackageName gpd) f)
+        pool' = Map.union (gpdPackages gpds) pool
+
+        dupError _ _ = error "Bug: Duplicate packages are not expected here"
+
+data BuildPlanCheck =
+      BuildPlanCheckOk      (Map PackageName (Map FlagName Bool))
+    | BuildPlanCheckPartial (Map PackageName (Map FlagName Bool)) DepErrors
+    | BuildPlanCheckFail    (Map PackageName (Map FlagName Bool)) DepErrors
+                            CompilerVersion
+
+-- | Check a set of 'GenericPackageDescription's and a set of flags against a
+-- given snapshot. Returns how well the snapshot satisfies the dependencies of
+-- the packages.
+checkSnapBuildPlan
+    :: ( MonadIO m, MonadCatch m, MonadLogger m, MonadReader env m
+       , HasHttpManager env, HasConfig env, HasGHCVariant env
+       , MonadBaseControl IO m)
+    => [GenericPackageDescription]
+    -> Maybe (Map PackageName (Map FlagName Bool))
+    -> SnapName
+    -> m BuildPlanCheck
+checkSnapBuildPlan gpds flags snap = do
+    platform <- asks (configPlatform . getConfig)
+    mbp <- loadMiniBuildPlan snap
+
+    let
+        compiler = mbpCompilerVersion mbp
+        snapPkgs = fmap mpiVersion $ mbpPackages mbp
+        (f, errs) = checkBundleBuildPlan platform compiler snapPkgs flags gpds
+        cerrs = compilerErrors compiler errs
+
+    if Map.null errs then
+        return $ BuildPlanCheckOk f
+    else if Map.null cerrs then do
+            return $ BuildPlanCheckPartial f errs
+        else
+            return $ BuildPlanCheckFail f cerrs compiler
+    where
+        compilerErrors compiler errs
+            | whichCompiler compiler == Ghc = ghcErrors errs
+            -- FIXME not sure how to handle ghcjs boot packages
+            | otherwise = Map.empty
+
+        isGhcWiredIn p _ = p `HashSet.member` wiredInPackages
+        ghcErrors = Map.filterWithKey isGhcWiredIn
+
+-- | Find a snapshot and set of flags that is compatible with and matches as
+-- best as possible with the given 'GenericPackageDescription's. Returns
+-- 'Nothing' if no such snapshot is found.
+selectBestSnapshot
+    :: ( MonadIO m, MonadCatch m, MonadLogger m, MonadReader env m
+       , HasHttpManager env, HasConfig env, HasGHCVariant env
+       , MonadBaseControl IO m)
+    => [GenericPackageDescription]
+    -> [SnapName]
+    -> m (Maybe SnapName)
+selectBestSnapshot gpds snaps = do
+    $logInfo $ "Selecting the best among "
+               <> T.pack (show (length snaps))
+               <> " snapshots...\n"
+    loop Nothing snaps
+    where
+        loop Nothing [] = return Nothing
+        loop (Just (snap, _)) [] = return $ Just snap
+        loop bestYet (snap:rest) = do
+            result <- checkSnapBuildPlan gpds Nothing snap
+            reportResult result snap
+            case result of
+                BuildPlanCheckFail _ _ _ -> loop bestYet rest
+                BuildPlanCheckOk _ -> return $ Just snap
+                BuildPlanCheckPartial _ e -> do
+                    case bestYet of
+                        Nothing -> loop (Just (snap, e)) rest
+                        Just prev ->
+                            loop (Just (betterSnap prev (snap, e))) rest
+
+        betterSnap (s1, e1) (s2, e2)
+          | (Map.size e1) <= (Map.size e2) = (s1, e1)
+          | otherwise = (s2, e2)
+
+        reportResult (BuildPlanCheckOk _) snap = do
+            $logInfo $ "* Selected " <> renderSnapName snap
+            $logInfo ""
+
+        reportResult (BuildPlanCheckPartial f errs) snap = do
+            $logWarn $ "* Partially matches " <> renderSnapName snap
+            $logWarn $ indent $ showDepErrors f errs
+
+        reportResult (BuildPlanCheckFail f errs compiler) snap = do
+            $logWarn $ "* Rejected " <> renderSnapName snap
+            $logWarn $ indent $ showCompilerErrors f errs compiler
+
+        indent t = T.unlines $ fmap ("    " <>) (T.lines t)
+
+showCompilerErrors
+    :: Map PackageName (Map FlagName Bool)
+    -> DepErrors
+    -> CompilerVersion
+    -> Text
+showCompilerErrors flags errs compiler =
+    -- TODO print the package filename to enable quick mapping for the user
+    T.concat
+        [ compilerVersionText compiler
+        , " cannot be used for these packages:\n"
+        , T.concat (map formatError (Map.toList errs))
+        , showDepErrors flags errs -- TODO only in debug mode
+        ]
+    where
+        formatError (_, DepError _ neededBy) = T.concat $
+            map formatItem (Map.toList neededBy)
+
+        formatItem (user, _) = T.concat
+            [ "    - "
+            , T.pack $ packageNameString user
+            , "\n"
+            ]
+
+showDepErrors :: Map PackageName (Map FlagName Bool) -> DepErrors -> Text
+showDepErrors flags errs =
+    T.concat $ map formatError (Map.toList errs)
+    where
+        formatError (depName, DepError mversion neededBy) = T.concat
+            [ showDepVersion depName mversion
+            , T.concat (map showRequirement (Map.toList neededBy))
+            -- TODO only in debug
+            , T.concat (map showFlags (Map.toList neededBy))
+            ]
+
+        showDepVersion depName mversion = T.concat
+            [ T.pack $ packageNameString depName
             , case mversion of
                 Nothing -> " not found"
                 Just version -> T.concat
@@ -623,14 +779,33 @@ displayDepErrors errs =
                     , T.pack $ versionString version
                     , " found"
                     ]
+            , "\n"
             ]
-        F.forM_ (Map.toList neededBy) $ \(user, range) -> $logInfo $ T.concat
+
+        showRequirement (user, range) = T.concat
             [ "    - "
             , T.pack $ packageNameString user
             , " requires "
             , T.pack $ display range
+            , "\n"
             ]
-        $logInfo ""
+
+        showFlags (user, _) =
+            maybe "" (printFlags user) (Map.lookup user flags)
+
+        printFlags user fl =
+            if (not $ Map.null fl) then
+                T.concat
+                    [ "    - "
+                    , T.pack $ packageNameString user
+                    , " flags: "
+                    , T.pack $ intercalate ", "
+                             $ map formatFlags (Map.toList fl)
+                    , "\n"
+                    ]
+            else ""
+
+        formatFlags (f, v) = (show f) ++ " = " ++ (show v)
 
 shadowMiniBuildPlan :: MiniBuildPlan
                     -> Set PackageName
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
index 7afaf934b5..151da4d682 100644
--- a/src/Stack/Config.hs
+++ b/src/Stack/Config.hs
@@ -28,17 +28,20 @@ module Stack.Config
   ,resolvePackageEntry
   ,getImplicitGlobalProjectDir
   ,getIsGMP4
+  ,getSnapshots
+  ,makeConcreteResolver
   ) where
 
 import qualified Codec.Archive.Tar as Tar
 import qualified Codec.Compression.GZip as GZip
 import           Control.Applicative
 import           Control.Arrow ((***))
+import           Control.Exception (assert)
 import           Control.Monad
 import           Control.Monad.Catch (MonadThrow, MonadCatch, catchAll, throwM)
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger hiding (Loc)
-import           Control.Monad.Reader (MonadReader, ask, runReaderT)
+import           Control.Monad.Reader (MonadReader, ask, asks, runReaderT)
 import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Crypto.Hash.SHA256 as SHA256
 import           Data.Aeson.Extended
@@ -58,7 +61,7 @@ import qualified Distribution.Text
 import           Distribution.Version (simplifyVersionRange)
 import           GHC.Conc (getNumProcessors)
 import           Network.HTTP.Client.Conduit (HasHttpManager, getHttpManager, Manager, parseUrl)
-import           Network.HTTP.Download (download)
+import           Network.HTTP.Download (download, downloadJSON)
 import           Options.Applicative (Parser, strOption, long, help)
 import           Path
 import           Path.Extra (toFilePathNoTrailingSep)
@@ -70,7 +73,6 @@ import           Stack.Config.Docker
 import           Stack.Config.Nix
 import           Stack.Constants
 import qualified Stack.Image as Image
-import           Stack.Init
 import           Stack.PackageIndex
 import           Stack.Types
 import           Stack.Types.Internal
@@ -79,6 +81,87 @@ import           System.Environment
 import           System.IO
 import           System.Process.Read
 
+-- | If deprecated path exists, use it and print a warning.
+-- Otherwise, return the new path.
+tryDeprecatedPath
+    :: (MonadIO m, MonadLogger m)
+    => Maybe T.Text -- ^ Description of file for warning (if Nothing, no deprecation warning is displayed)
+    -> (Path Abs a -> m Bool) -- ^ Test for existence
+    -> Path Abs a -- ^ New path
+    -> Path Abs a -- ^ Deprecated path
+    -> m (Path Abs a, Bool) -- ^ (Path to use, whether it already exists)
+tryDeprecatedPath mWarningDesc exists new old = do
+    newExists <- exists new
+    if newExists
+        then return (new, True)
+        else do
+            oldExists <- exists old
+            if oldExists
+                then do
+                    case mWarningDesc of
+                        Nothing -> return ()
+                        Just desc ->
+                            $logWarn $ T.concat
+                                [ "Warning: Location of ", desc, " at '"
+                                , T.pack (toFilePath old)
+                                , "' is deprecated; rename it to '"
+                                , T.pack (toFilePath new)
+                                , "' instead" ]
+                    return (old, True)
+                else return (new, False)
+
+-- | Get the location of the implicit global project directory.
+-- If the directory already exists at the deprecated location, its location is returned.
+-- Otherwise, the new location is returned.
+getImplicitGlobalProjectDir
+    :: (MonadIO m, MonadLogger m)
+    => Config -> m (Path Abs Dir)
+getImplicitGlobalProjectDir config =
+    --TEST no warning printed
+    liftM fst $ tryDeprecatedPath
+        Nothing
+        dirExists
+        (implicitGlobalProjectDir stackRoot)
+        (implicitGlobalProjectDirDeprecated stackRoot)
+  where
+    stackRoot = configStackRoot config
+
+-- | Download the 'Snapshots' value from stackage.org.
+getSnapshots :: (MonadThrow m, MonadIO m, MonadReader env m, HasHttpManager env, HasStackRoot env, HasConfig env)
+             => m Snapshots
+getSnapshots = askLatestSnapshotUrl >>= parseUrl . T.unpack >>= downloadJSON
+
+-- | Turn an 'AbstractResolver' into a 'Resolver'.
+makeConcreteResolver :: (MonadIO m, MonadReader env m, HasConfig env, MonadThrow m, HasHttpManager env, MonadLogger m)
+                     => AbstractResolver
+                     -> m Resolver
+makeConcreteResolver (ARResolver r) = return r
+makeConcreteResolver ar = do
+    snapshots <- getSnapshots
+    r <-
+        case ar of
+            ARResolver r -> assert False $ return r
+            ARGlobal -> do
+                config <- asks getConfig
+                implicitGlobalDir <- getImplicitGlobalProjectDir config
+                let fp = implicitGlobalDir </> stackDotYaml
+                (ProjectAndConfigMonoid project _, _warnings) <-
+                    liftIO (Yaml.decodeFileEither $ toFilePath fp)
+                    >>= either throwM return
+                return $ projectResolver project
+            ARLatestNightly -> return $ ResolverSnapshot $ Nightly $ snapshotsNightly snapshots
+            ARLatestLTSMajor x ->
+                case IntMap.lookup x $ snapshotsLts snapshots of
+                    Nothing -> error $ "No LTS release found with major version " ++ show x
+                    Just y -> return $ ResolverSnapshot $ LTS x y
+            ARLatestLTS
+                | IntMap.null $ snapshotsLts snapshots -> error "No LTS releases found"
+                | otherwise ->
+                    let (x, y) = IntMap.findMax $ snapshotsLts snapshots
+                     in return $ ResolverSnapshot $ LTS x y
+    $logInfo $ "Selected resolver: " <> resolverName r
+    return r
+
 -- | Get the latest snapshot resolver available.
 getLatestResolver
     :: (MonadIO m, MonadThrow m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m)
diff --git a/src/Stack/ConfigCmd.hs b/src/Stack/ConfigCmd.hs
index 987845583f..ec83546155 100644
--- a/src/Stack/ConfigCmd.hs
+++ b/src/Stack/ConfigCmd.hs
@@ -21,7 +21,7 @@ import qualified Data.Yaml as Yaml
 import           Network.HTTP.Client.Conduit (HasHttpManager)
 import           Path
 import           Stack.BuildPlan
-import           Stack.Init
+import           Stack.Config (makeConcreteResolver)
 import           Stack.Types
 
 data ConfigCmdSet = ConfigCmdSetResolver AbstractResolver
diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs
index a4fd92b781..c71ecda940 100644
--- a/src/Stack/Init.hs
+++ b/src/Stack/Init.hs
@@ -3,96 +3,89 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TemplateHaskell       #-}
 module Stack.Init
-    ( findCabalFiles
-    , initProject
+    ( initProject
     , InitOpts (..)
     , SnapPref (..)
     , Method (..)
-    , makeConcreteResolver
-    , tryDeprecatedPath
-    , getImplicitGlobalProjectDir
     ) where
 
 import           Control.Exception               (assert)
 import           Control.Exception.Enclosed      (catchAny, handleIO)
-import           Control.Monad                   (liftM, when, zipWithM_)
-import           Control.Monad.Catch             (MonadMask, MonadThrow, throwM)
+import           Control.Monad                   (liftM, when)
+import           Control.Monad.Catch             (MonadMask, throwM)
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
-import           Control.Monad.Reader            (MonadReader, asks)
+import           Control.Monad.Reader            (MonadReader)
 import           Control.Monad.Trans.Control     (MonadBaseControl)
 import qualified Data.ByteString.Builder         as B
 import qualified Data.ByteString.Lazy            as L
 import qualified Data.HashMap.Strict             as HM
 import qualified Data.IntMap                     as IntMap
 import qualified Data.Foldable                   as F
-import           Data.List                       (isSuffixOf,sortBy)
+import           Data.List                       (sortBy)
 import           Data.List.Extra                 (nubOrd)
 import           Data.Map                        (Map)
 import qualified Data.Map                        as Map
 import           Data.Maybe                      (mapMaybe)
 import           Data.Monoid
-import           Data.Set                        (Set)
-import qualified Data.Set                        as Set
 import qualified Data.Text                       as T
 import qualified Data.Yaml                       as Yaml
 import qualified Distribution.PackageDescription as C
 import           Network.HTTP.Client.Conduit     (HasHttpManager)
 import           Path
-import           Path.Find
 import           Path.IO
 import           Stack.BuildPlan
 import           Stack.Constants
-import           Stack.Package
 import           Stack.Solver
 import           Stack.Types
-import           System.Directory                (getDirectoryContents)
-
-findCabalFiles :: MonadIO m => Bool -> Path Abs Dir -> m [Path Abs File]
-findCabalFiles recurse dir =
-    liftIO $ findFiles dir isCabal (\subdir -> recurse && not (isIgnored subdir))
-  where
-    isCabal path = ".cabal" `isSuffixOf` toFilePath path
-
-    isIgnored path = toFilePath (dirname path) `Set.member` ignoredDirs
-
--- | Special directories that we don't want to traverse for .cabal files
-ignoredDirs :: Set FilePath
-ignoredDirs = Set.fromList
-    [ ".git"
-    , "dist"
-    , ".stack-work"
-    ]
+import           Stack.Types.Internal            ( HasTerminal, HasReExec
+                                                 , HasLogLevel)
+import           System.Directory                ( getDirectoryContents
+                                                 , makeRelativeToCurrentDirectory)
+import           Stack.Config                    ( getSnapshots
+                                                 , makeConcreteResolver)
 
 -- | Generate stack.yaml
-initProject :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, HasGHCVariant env, MonadLogger m, MonadBaseControl IO m)
-            => Path Abs Dir
-            -> InitOpts
-            -> m ()
+initProject
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => Path Abs Dir
+    -> InitOpts
+    -> m ()
 initProject currDir initOpts = do
     let dest = currDir </> stackDotYaml
         dest' = toFilePath dest
+
+    reldest <- liftIO $ makeRelativeToCurrentDirectory dest'
+
     exists <- fileExists dest
-    when (not (forceOverwrite initOpts) && exists) $
-      error ("Refusing to overwrite existing stack.yaml, " <>
-             "please delete before running stack init " <>
-             "or if you are sure use \"--force\"")
+    when (not (forceOverwrite initOpts) && exists) $ do
+        error ("Stack configuration file " <> reldest <>
+               " exists, use 'stack solver' to fix the existing config file or \
+               \'--force' to overwrite it.")
 
-    cabalfps <- findCabalFiles (includeSubDirs initOpts) currDir
-    $logInfo $ "Writing default config file to: " <> T.pack dest'
-    $logInfo $ "Basing on cabal files:"
-    mapM_ (\path -> $logInfo $ "- " <> T.pack (toFilePath path)) cabalfps
-    $logInfo ""
+    let noPkgMsg =  "In order to init, you should have an existing .cabal \
+                    \file. Please try \"stack new\" instead."
 
-    when (null cabalfps) $ error "In order to init, you should have an existing .cabal file. Please try \"stack new\" instead"
-    (warnings,gpds) <- fmap unzip (mapM readPackageUnresolved cabalfps)
-    zipWithM_ (mapM_ . printCabalFileWarning) cabalfps warnings
+        dupPkgFooter = "You have the following options:\n"
+            <> "- Use '--ignore-subdirs' command line switch to ignore "
+            <> "packages in subdirectories. You can init subdirectories as "
+            <> "independent projects.\n"
+            <> "- Put selected packages in the stack config file "
+            <> "and then use 'stack solver' command to automatically resolve "
+            <> "dependencies and update the config file."
 
-    (r, flags, extraDeps) <- getDefaultResolver cabalfps gpds initOpts
+    cabalfps <- findCabalFiles (includeSubDirs initOpts) currDir
+    gpds <- cabalPackagesCheck cabalfps noPkgMsg dupPkgFooter
+
+    (r, flags, extraDeps) <-
+        getDefaultResolver dest (map parent cabalfps) gpds initOpts
     let p = Project
             { projectPackages = pkgs
             , projectExtraDeps = extraDeps
-            , projectFlags = flags
+            , projectFlags = removeSrcPkgDefaultFlags gpds flags
             , projectResolver = r
             , projectCompiler = Nothing
             , projectExtraPackageDBs = []
@@ -109,9 +102,14 @@ initProject currDir initOpts = do
                     Just rel -> toFilePath rel
             , peSubdirs = []
             }
-    $logInfo $ "Selected resolver: " <> resolverName r
+
+    $logInfo $ "Initialising configuration using resolver: " <> resolverName r
+    $logInfo $
+        (if exists then "Overwriting existing configuration file: "
+         else "Writing configuration to file: ")
+        <> T.pack reldest
     liftIO $ L.writeFile dest' $ B.toLazyByteString $ renderStackYaml p
-    $logInfo $ "Wrote project config to: " <> T.pack dest'
+    $logInfo "All done."
 
 -- | Render a stack.yaml file with comments, see:
 -- https://github.com/commercialhaskell/stack/issues/226
@@ -183,48 +181,79 @@ getSnapshots' =
         return Nothing
 
 -- | Get the default resolver value
-getDefaultResolver :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, HasGHCVariant env, MonadLogger m, MonadBaseControl IO m)
-                   => [Path Abs File] -- ^ cabal files
-                   -> [C.GenericPackageDescription] -- ^ cabal descriptions
-                   -> InitOpts
-                   -> m (Resolver, Map PackageName (Map FlagName Bool), Map PackageName Version)
-getDefaultResolver cabalfps gpds initOpts =
-    case ioMethod initOpts of
-        MethodSnapshot snapPref -> do
-            msnapshots <- getSnapshots'
-            names <-
-                case msnapshots of
-                    Nothing -> return []
-                    Just snapshots -> getRecommendedSnapshots snapshots snapPref
-            mpair <- findBuildPlan gpds names
-            case mpair of
-                Just (snap, flags) ->
-                    return (ResolverSnapshot snap, flags, Map.empty)
-                Nothing -> throwM $ NoMatchingSnapshot names
-        MethodResolver aresolver -> do
-            resolver <- makeConcreteResolver aresolver
-            mpair <-
-                case resolver of
-                    ResolverSnapshot name -> findBuildPlan gpds [name]
-                    ResolverCompiler _ -> return Nothing
-                    ResolverCustom _ _ -> return Nothing
-            case mpair of
-                Just (snap, flags) ->
-                    return (ResolverSnapshot snap, flags, Map.empty)
-                Nothing -> return (resolver, Map.empty, Map.empty)
-        MethodSolver -> do
-            (compilerVersion, extraDeps) <- cabalSolver Ghc (map parent cabalfps) Map.empty Map.empty []
-            return
-                ( ResolverCompiler compilerVersion
-                , Map.filter (not . Map.null) $ fmap snd extraDeps
-                , fmap fst extraDeps
-                )
+getDefaultResolver
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => Path Abs File   -- ^ stack.yaml
+    -> [Path Abs Dir]  -- ^ cabal dirs
+    -> [C.GenericPackageDescription] -- ^ cabal descriptions
+    -> InitOpts
+    -> m ( Resolver
+         , Map PackageName (Map FlagName Bool)
+         , Map PackageName Version)
+getDefaultResolver stackYaml cabalDirs gpds initOpts = do
+    resolver <- getResolver (ioMethod initOpts)
+    result   <- checkResolverSpec gpds Nothing resolver
+
+    case result of
+        BuildPlanCheckOk f-> return (resolver, f, Map.empty)
+        BuildPlanCheckPartial f e
+            | needSolver resolver initOpts -> solve (resolver, f)
+            | otherwise ->
+                throwM $ ResolverPartial resolver (showDepErrors f e)
+        BuildPlanCheckFail f e c ->
+            throwM $ ResolverMismatch resolver (showCompilerErrors f e c)
+
+    where
+      solve (res, f) = do
+          let srcConstraints = mergeConstraints (gpdPackages gpds) f
+          mresolver <- solveResolverSpec stackYaml cabalDirs
+                                         (res, srcConstraints, Map.empty)
+          case mresolver of
+              Just (src, ext) -> do
+                  return (res, fmap snd (Map.union src ext), fmap fst ext)
+              Nothing
+                  | forceOverwrite initOpts -> do
+                      $logWarn "\nSolver could not arrive at a workable build \
+                               \plan.\nProceeding to create a config with an \
+                               \incomplete plan anyway..."
+                      return (res, f, Map.empty)
+                  | otherwise -> throwM (SolverGiveUp giveUpMsg)
+
+      giveUpMsg = concat
+          [ "    - Use '--ignore-subdirs' to skip packages in subdirectories.\n"
+          , "    - Update external packages with 'stack update' and try again.\n"
+          , "    - Use '--force' to create an initial "
+          , toFilePath stackDotYaml <> ", tweak it and run 'stack solver':\n"
+          , "        - Remove any unnecessary packages.\n"
+          , "        - Add any missing remote packages.\n"
+          , "        - Add extra dependencies to guide solver.\n"
+          ]
+
+      -- TODO support selecting best across regular and custom snapshots
+      getResolver (MethodSnapshot snapPref)  = selectSnapResolver snapPref
+      getResolver (MethodResolver aresolver) = makeConcreteResolver aresolver
+
+      selectSnapResolver snapPref = do
+          msnaps <- getSnapshots'
+          snaps <- maybe (error "No snapshots to select from.")
+                         (getRecommendedSnapshots snapPref)
+                         msnaps
+          selectBestSnapshot gpds snaps
+            >>= maybe (throwM (NoMatchingSnapshot snaps))
+                      (return . ResolverSnapshot)
+
+      needSolver _ (InitOpts {useSolver = True}) = True
+      needSolver (ResolverCompiler _)  _ = True
+      needSolver _ _ = False
 
 getRecommendedSnapshots :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, HasGHCVariant env, MonadLogger m, MonadBaseControl IO m)
-                        => Snapshots
-                        -> SnapPref
+                        => SnapPref
+                        -> Snapshots
                         -> m [SnapName]
-getRecommendedSnapshots snapshots pref = do
+getRecommendedSnapshots pref snapshots = do
     -- Get the most recent LTS and Nightly in the snapshots directory and
     -- prefer them over anything else, since odds are high that something
     -- already exists for them.
@@ -256,6 +285,8 @@ getRecommendedSnapshots snapshots pref = do
 
 data InitOpts = InitOpts
     { ioMethod       :: !Method
+    -- ^ Use solver
+    , useSolver :: Bool
     -- ^ Preferred snapshots
     , forceOverwrite :: Bool
     -- ^ Overwrite existing files
@@ -266,80 +297,4 @@ data InitOpts = InitOpts
 data SnapPref = PrefNone | PrefLTS | PrefNightly
 
 -- | Method of initializing
-data Method = MethodSnapshot SnapPref | MethodResolver AbstractResolver | MethodSolver
-
--- | Turn an 'AbstractResolver' into a 'Resolver'.
-makeConcreteResolver :: (MonadIO m, MonadReader env m, HasConfig env, MonadThrow m, HasHttpManager env, MonadLogger m)
-                     => AbstractResolver
-                     -> m Resolver
-makeConcreteResolver (ARResolver r) = return r
-makeConcreteResolver ar = do
-    snapshots <- getSnapshots
-    r <-
-        case ar of
-            ARResolver r -> assert False $ return r
-            ARGlobal -> do
-                config <- asks getConfig
-                implicitGlobalDir <- getImplicitGlobalProjectDir config
-                let fp = implicitGlobalDir </> stackDotYaml
-                (ProjectAndConfigMonoid project _, _warnings) <-
-                    liftIO (Yaml.decodeFileEither $ toFilePath fp)
-                    >>= either throwM return
-                return $ projectResolver project
-            ARLatestNightly -> return $ ResolverSnapshot $ Nightly $ snapshotsNightly snapshots
-            ARLatestLTSMajor x ->
-                case IntMap.lookup x $ snapshotsLts snapshots of
-                    Nothing -> error $ "No LTS release found with major version " ++ show x
-                    Just y -> return $ ResolverSnapshot $ LTS x y
-            ARLatestLTS
-                | IntMap.null $ snapshotsLts snapshots -> error "No LTS releases found"
-                | otherwise ->
-                    let (x, y) = IntMap.findMax $ snapshotsLts snapshots
-                     in return $ ResolverSnapshot $ LTS x y
-    $logInfo $ "Selected resolver: " <> resolverName r
-    return r
-
--- | Get the location of the implicit global project directory.
--- If the directory already exists at the deprecated location, its location is returned.
--- Otherwise, the new location is returned.
-getImplicitGlobalProjectDir
-    :: (MonadIO m, MonadLogger m)
-    => Config -> m (Path Abs Dir)
-getImplicitGlobalProjectDir config =
-    --TEST no warning printed
-    liftM fst $ tryDeprecatedPath
-        Nothing
-        dirExists
-        (implicitGlobalProjectDir stackRoot)
-        (implicitGlobalProjectDirDeprecated stackRoot)
-  where
-    stackRoot = configStackRoot config
-
--- | If deprecated path exists, use it and print a warning.
--- Otherwise, return the new path.
-tryDeprecatedPath
-    :: (MonadIO m, MonadLogger m)
-    => Maybe T.Text -- ^ Description of file for warning (if Nothing, no deprecation warning is displayed)
-    -> (Path Abs a -> m Bool) -- ^ Test for existence
-    -> Path Abs a -- ^ New path
-    -> Path Abs a -- ^ Deprecated path
-    -> m (Path Abs a, Bool) -- ^ (Path to use, whether it already exists)
-tryDeprecatedPath mWarningDesc exists new old = do
-    newExists <- exists new
-    if newExists
-        then return (new, True)
-        else do
-            oldExists <- exists old
-            if oldExists
-                then do
-                    case mWarningDesc of
-                        Nothing -> return ()
-                        Just desc ->
-                            $logWarn $ T.concat
-                                [ "Warning: Location of ", desc, " at '"
-                                , T.pack (toFilePath old)
-                                , "' is deprecated; rename it to '"
-                                , T.pack (toFilePath new)
-                                , "' instead" ]
-                    return (old, True)
-                else return (new, False)
+data Method = MethodSnapshot SnapPref | MethodResolver AbstractResolver
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
index 2810364f53..4851771498 100644
--- a/src/Stack/Options.hs
+++ b/src/Stack/Options.hs
@@ -670,20 +670,18 @@ globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts
 
 initOptsParser :: Parser InitOpts
 initOptsParser =
-    InitOpts <$> method <*> overwrite <*> fmap not ignoreSubDirs
+    InitOpts <$> method <*> solver <*> overwrite <*> fmap not ignoreSubDirs
   where
     ignoreSubDirs = switch (long "ignore-subdirs" <>
                            help "Do not search for .cabal files in sub directories")
     overwrite = switch (long "force" <>
-                       help "Force overwriting of an existing stack.yaml if it exists")
-    method = solver
-         <|> (MethodResolver <$> resolver)
-         <|> (MethodSnapshot <$> snapPref)
+                       help "Force overwriting an existing stack.yaml or \
+                            \creating a stack.yaml with incomplete config.")
+    solver = switch (long "solver" <>
+             help "Use a dependency solver to determine extra dependencies")
 
-    solver =
-        flag' MethodSolver
-            (long "solver" <>
-             help "Use a dependency solver to determine dependencies")
+    method = (MethodResolver <$> resolver)
+         <|> (MethodSnapshot <$> snapPref)
 
     snapPref =
         flag' PrefLTS
@@ -697,7 +695,7 @@ initOptsParser =
     resolver = option readAbstractResolver
         (long "resolver" <>
          metavar "RESOLVER" <>
-         help "Use the given resolver, even if not all dependencies are met")
+         help "Use the specified resolver")
 
 -- | Parser for a logging level.
 logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
@@ -786,8 +784,8 @@ ghcVariantParser hide =
 -- | Parser for @solverCmd@
 solverOptsParser :: Parser Bool
 solverOptsParser = boolFlags False
-    "modify-stack-yaml"
-    "Automatically modify stack.yaml with the solver's recommendations"
+    "update-config"
+    "Automatically update stack.yaml with the solver's recommendations"
     idm
 
 -- | Parser for test arguments.
diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs
index dbc26c5267..8b38ecaf80 100644
--- a/src/Stack/Setup.hs
+++ b/src/Stack/Setup.hs
@@ -16,8 +16,10 @@ module Stack.Setup
   ( setupEnv
   , ensureCompiler
   , ensureDockerStackExe
+  , getSystemCompiler
   , SetupOpts (..)
   , defaultStackSetupYaml
+  , removeHaskellEnvVars
   ) where
 
 import           Control.Applicative
diff --git a/src/Stack/Setup/Installed.hs b/src/Stack/Setup/Installed.hs
index 2ba12b2f95..5840ae8afe 100644
--- a/src/Stack/Setup/Installed.hs
+++ b/src/Stack/Setup/Installed.hs
@@ -152,7 +152,7 @@ data ExtraDirs = ExtraDirs
     { edBins :: ![FilePath]
     , edInclude :: ![FilePath]
     , edLib :: ![FilePath]
-    }
+    } deriving (Show)
 instance Monoid ExtraDirs where
     mempty = ExtraDirs [] [] []
     mappend (ExtraDirs a b c) (ExtraDirs x y z) = ExtraDirs
diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs
index c940737e1d..3c12cf9ec5 100644
--- a/src/Stack/Solver.hs
+++ b/src/Stack/Solver.hs
@@ -3,11 +3,16 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TemplateHaskell       #-}
 module Stack.Solver
-    ( cabalSolver
+    ( checkResolverSpec
+    , cabalPackagesCheck
+    , findCabalFiles
+    , mergeConstraints
     , solveExtraDeps
+    , solveResolverSpec
     ) where
 
 import           Control.Applicative
+import           Control.Exception (assert)
 import           Control.Exception.Enclosed  (tryIO)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
@@ -18,67 +23,64 @@ import           Data.Aeson.Extended         (object, (.=), toJSON, logJSONWarni
 import qualified Data.ByteString             as S
 import           Data.Either
 import qualified Data.HashMap.Strict         as HashMap
+import           Data.List                   ((\\), isSuffixOf, intercalate)
+import           Data.List.Extra             (groupSortOn)
 import           Data.Map                    (Map)
 import qualified Data.Map                    as Map
 import           Data.Monoid
+import           Data.Set                    (Set)
+import qualified Data.Set                    as Set
 import           Data.Text                   (Text)
 import qualified Data.Text                   as T
 import           Data.Text.Encoding          (decodeUtf8, encodeUtf8)
+import           Data.Text.Encoding.Error    (lenientDecode)
+import qualified Data.Text.Lazy              as LT
+import           Data.Text.Lazy.Encoding     (decodeUtf8With)
 import qualified Data.Yaml                   as Yaml
+import qualified Distribution.PackageDescription as C
 import           Network.HTTP.Client.Conduit (HasHttpManager)
 import           Path
-import           Path.IO                     (parseRelAsAbsDir)
+import           Path.Find                   (findFiles)
+import           Path.IO                     (getWorkingDir, parseRelAsAbsDir)
 import           Prelude
 import           Stack.BuildPlan
+import           Stack.Constants             (stackDotYaml)
+import           Stack.Package               (printCabalFileWarning
+                                             , readPackageUnresolved)
+import           Stack.Setup
 import           Stack.Setup.Installed
 import           Stack.Types
+import           Stack.Types.Internal        ( HasTerminal
+                                             , HasReExec
+                                             , HasLogLevel)
 import           System.Directory            (copyFile,
                                               createDirectoryIfMissing,
-                                              getTemporaryDirectory)
+                                              getTemporaryDirectory,
+                                              makeRelativeToCurrentDirectory)
 import qualified System.FilePath             as FP
 import           System.IO.Temp              (withSystemTempDirectory)
 import           System.Process.Read
 
+data ConstraintType = Constraint | Preference deriving (Eq)
+type ConstraintSpec = Map PackageName (Version, Map FlagName Bool)
+
 cabalSolver :: (MonadIO m, MonadLogger m, MonadMask m, MonadBaseControl IO m, MonadReader env m, HasConfig env)
-            => WhichCompiler
+            => EnvOverride
             -> [Path Abs Dir] -- ^ cabal files
-            -> Map PackageName Version -- ^ constraints
-            -> Map PackageName (Map FlagName Bool) -- ^ user-specified flags
+            -> ConstraintType
+            -> ConstraintSpec -- ^ src constraints
+            -> ConstraintSpec -- ^ dep constraints
             -> [String] -- ^ additional arguments
-            -> m (CompilerVersion, Map PackageName (Version, Map FlagName Bool))
-cabalSolver wc cabalfps constraints userFlags cabalArgs = withSystemTempDirectory "cabal-solver" $ \dir -> do
-    when (null cabalfps) $ throwM SolverNoCabalFiles
-    configLines <- getCabalConfig dir constraints
+            -> m (Maybe ConstraintSpec)
+cabalSolver menv cabalfps constraintType
+            srcConstraints depConstraints cabalArgs =
+  withSystemTempDirectory "cabal-solver" $ \dir -> do
+
+    let versionConstraints = fmap fst depConstraints
+    configLines <- getCabalConfig dir constraintType versionConstraints
     let configFile = dir FP.</> "cabal.config"
     liftIO $ S.writeFile configFile $ encodeUtf8 $ T.unlines configLines
 
-    menv0 <- getMinimalEnvOverride
-    mghc <- findExecutable menv0 "ghc"
-    platform <- asks getPlatform
-    menv <-
-        case mghc of
-            Just _ -> return menv0
-            Nothing -> do
-                localPrograms <- asks $ configLocalPrograms . getConfig
-                tools <- listInstalled localPrograms
-                let ghcName = $(mkPackageName "ghc")
-                case [version | Tool (PackageIdentifier name version) <- tools, name == ghcName] of
-                    [] -> throwM SolverMissingGHC
-                    versions -> do
-                        let version = maximum versions
-                        $logInfo $ "No GHC on path, selecting: " <>
-                                   T.pack (versionString version)
-                        ed <- extraDirs $ Tool $ PackageIdentifier ghcName version
-                        pathsEnv <- augmentPathMap (edBins ed)
-                                                   (unEnvOverride menv0)
-                        mkEnvOverride platform pathsEnv
-    mcabal <- findExecutable menv "cabal"
-    case mcabal of
-        Nothing -> throwM SolverMissingCabalInstall
-        Just _ -> return ()
-
-    compilerVersion <- getCompilerVersion menv wc
-
     -- Run from a temporary directory to avoid cabal getting confused by any
     -- sandbox files, see:
     -- https://github.com/commercialhaskell/stack/issues/356
@@ -91,7 +93,6 @@ cabalSolver wc cabalfps constraints userFlags cabalArgs = withSystemTempDirector
              : "install"
              : "--enable-tests"
              : "--enable-benchmarks"
-             : "-v"
              : "--dry-run"
              : "--only-dependencies"
              : "--reorder-goals"
@@ -99,28 +100,45 @@ cabalSolver wc cabalfps constraints userFlags cabalArgs = withSystemTempDirector
              : "--package-db=clear"
              : "--package-db=global"
              : cabalArgs ++
-               toConstraintArgs userFlags ++
-               fmap toFilePath cabalfps ++
-               ["--ghcjs" | wc == Ghcjs]
-
-    $logInfo "Asking cabal to calculate a build plan, please wait"
-
-    menv' <- mkEnvOverride platform
-           $ Map.delete "GHCJS_PACKAGE_PATH"
-           $ Map.delete "GHC_PACKAGE_PATH" $ unEnvOverride menv
-    bs <- readProcessStdout (Just tmpdir) menv' "cabal" args
-    let ls = drop 1
-           $ dropWhile (not . T.isPrefixOf "In order, ")
-           $ T.lines
-           $ decodeUtf8 bs
-        (errs, pairs) = partitionEithers $ map parseLine ls
-    if null errs
-        then return (compilerVersion, Map.fromList pairs)
-        else error $ "Could not parse cabal-install output: " ++ show errs
+               toConstraintArgs (flagConstraints constraintType) ++
+               fmap toFilePath cabalfps
+
+    catch (liftM Just (readProcessStdout (Just tmpdir) menv "cabal" args))
+          (\e@(ReadProcessException _ _ _ err) -> do
+              let errMsg = decodeUtf8With lenientDecode err
+              if LT.isInfixOf "Could not resolve dependencies" errMsg
+              then do
+                  $logInfo "Attempt failed."
+                  $logInfo "\n>>>> Cabal errors begin"
+                  $logInfo $ LT.toStrict errMsg
+                             <> "<<<< Cabal errors end\n"
+                  return Nothing
+              else throwM e)
+    >>= maybe (return Nothing) parseCabalOutput
+
   where
+    parseCabalOutput bs = do
+        let ls = drop 1
+               $ dropWhile (not . T.isPrefixOf "In order, ")
+               $ T.lines
+               $ decodeUtf8 bs
+            (errs, pairs) = partitionEithers $ map parseLine ls
+        if null errs
+          then return $ Just (Map.fromList pairs)
+          else error $ "Could not parse cabal-install output: " ++ show errs
+
     parseLine t0 = maybe (Left t0) Right $ do
-        -- get rid of (new package) and (latest: ...) bits
-        ident':flags' <- Just $ T.words $ T.takeWhile (/= '(') t0
+        -- Sample output to parse:
+        -- text-1.2.1.1 (latest: 1.2.2.0) -integer-simple (via: parsec-3.1.9) (new package))
+        -- An ugly parser to extract module id and flags
+        let t1 = T.concat $
+                 [ T.takeWhile (/= '(')
+                 ,   (T.takeWhile (/= '('))
+                   . (T.drop 1)
+                   . (T.dropWhile (/= ')'))
+                 ] <*> [t0]
+
+        ident':flags' <- Just $ T.words t1
         PackageIdentifier name version <-
             parsePackageIdentifierFromString $ T.unpack ident'
         flags <- mapM parseFlag flags'
@@ -137,18 +155,30 @@ cabalSolver wc cabalfps constraints userFlags cabalArgs = withSystemTempDirector
                         Just x -> (x, True)
                 Just x -> (x, False)
     toConstraintArgs userFlagMap =
-        [formatFlagConstraint package flag enabled | (package, fs) <- Map.toList userFlagMap
-                                                   , (flag, enabled) <- Map.toList fs]
+        [formatFlagConstraint package flag enabled
+            | (package, fs) <- Map.toList userFlagMap
+            , (flag, enabled) <- Map.toList fs]
+
     formatFlagConstraint package flag enabled =
         let sign = if enabled then '+' else '-'
         in
         "--constraint=" ++ unwords [packageNameString package, sign : flagNameString flag]
 
-getCabalConfig :: (MonadReader env m, HasConfig env, MonadIO m, MonadThrow m)
+    -- Note the order of the Map union is important
+    -- We override a package in snapshot by a src package
+    flagConstraints Constraint = fmap snd (Map.union srcConstraints
+                                           depConstraints)
+    -- Even when using preferences we want to
+    -- keep the src package flags unchanged
+    -- TODO - this should be done only for manual flags.
+    flagConstraints Preference = fmap snd srcConstraints
+
+getCabalConfig :: (MonadLogger m, MonadReader env m, HasConfig env, MonadIO m, MonadThrow m)
                => FilePath -- ^ temp dir
+               -> ConstraintType
                -> Map PackageName Version -- ^ constraints
                -> m [Text]
-getCabalConfig dir constraints = do
+getCabalConfig dir constraintType constraints = do
     indices <- asks $ configPackageIndices . getConfig
     remotes <- mapM goIndex indices
     let cache = T.pack $ "remote-repo-cache: " ++ dir
@@ -167,71 +197,420 @@ getCabalConfig dir constraints = do
             , ":http://0.0.0.0/fake-url"
             ]
 
-    goConstraint (name, version) = T.concat
-        [ "constraint: "
-        , T.pack $ packageNameString name
-        , "=="
-        , T.pack $ versionString version
-        ]
-
--- | Determine missing extra-deps
-solveExtraDeps :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadMask m, MonadLogger m, MonadBaseControl IO m, HasHttpManager env)
-               => Bool -- ^ modify stack.yaml?
-               -> m ()
+    goConstraint (name, version) =
+        assert (not . null . versionString $ version) $
+            T.concat
+              [ (if constraintType == Constraint
+                 then "constraint: "
+                 else "preference: ")
+              , T.pack $ packageNameString name
+              , "=="
+              , T.pack $ versionString version
+              ]
+
+setupCompiler
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => CompilerVersion
+    -> m (Maybe ExtraDirs)
+setupCompiler compiler = do
+    let msg = Just $ T.concat
+          [ "Compiler version (" <> compilerVersionText compiler <> ") "
+          , "required by your resolver specification cannot be found.\n\n"
+          , "Please use '--install-ghc' command line switch to automatically "
+          , "install the compiler or '--system-ghc' to use a suitable "
+          , "compiler available on your PATH." ]
+
+    config <- asks getConfig
+    mpaths <- ensureCompiler SetupOpts
+        { soptsInstallIfMissing  = configInstallGHC config
+        , soptsUseSystem         = configSystemGHC config
+        , soptsWantedCompiler    = compiler
+        , soptsCompilerCheck     = configCompilerCheck config
+
+        , soptsStackYaml         = Nothing
+        , soptsForceReinstall    = False
+        , soptsSanityCheck       = False
+        , soptsSkipGhcCheck      = False
+        , soptsSkipMsys          = configSkipMsys config
+        , soptsUpgradeCabal      = False
+        , soptsResolveMissingGHC = msg
+        , soptsStackSetupYaml    = defaultStackSetupYaml
+        , soptsGHCBindistURL     = Nothing
+        }
+
+    return mpaths
+
+setupCabalEnv
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => CompilerVersion
+    -> m EnvOverride
+setupCabalEnv compiler = do
+    mpaths <- setupCompiler compiler
+    menv0 <- getMinimalEnvOverride
+    envMap <- removeHaskellEnvVars
+              <$> augmentPathMap (maybe [] edBins mpaths)
+                                 (unEnvOverride menv0)
+    platform <- asks getPlatform
+    menv <- mkEnvOverride platform envMap
+
+    mcabal <- findExecutable menv "cabal"
+    case mcabal of
+        Nothing -> throwM SolverMissingCabalInstall
+        Just _ -> return ()
+
+    mver <- getSystemCompiler menv (whichCompiler compiler)
+    case mver of
+        Just (version, _) ->
+            $logInfo $ "Using compiler: " <> compilerVersionText version
+        Nothing -> error "Failed to determine compiler version. \
+                         \This is most likely a bug."
+    return menv
+
+mergeConstraints
+    :: Map PackageName v
+    -> Map PackageName (Map p f)
+    -> Map PackageName (v, Map p f)
+mergeConstraints = Map.mergeWithKey
+    -- combine entry in both maps
+    (\_ v f -> Just (v, f))
+    -- convert entry in first map only
+    (fmap (flip (,) Map.empty))
+    -- convert entry in second map only
+    (\m -> if Map.null m then Map.empty
+           else error "Bug: An entry in flag map must have a corresponding \
+                      \entry in the version map")
+
+diffConstraints
+    :: (Eq v, Eq f)
+    => (v, f) -> (v, f) -> Maybe (v, f)
+diffConstraints (v, f) (v', f')
+    | (v == v') && (f == f') = Nothing
+    | otherwise              = Just (v, f)
+
+solveResolverSpec
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => Path Abs File  -- ^ stack.yaml file location
+    -> [Path Abs Dir] -- ^ package dirs containing cabal files
+    -> ( Resolver
+       , ConstraintSpec -- ^ src package constraints
+       , ConstraintSpec) -- ^ extra dependency constraints
+    -> m (Maybe ( ConstraintSpec -- ^ resulting src package specs
+                , ConstraintSpec)) -- ^ resulting external package specs
+solveResolverSpec stackYaml cabalDirs
+                  (resolver, srcConstraints, extraConstraints) = do
+    $logInfo $ "Using resolver: " <> resolverName resolver
+    (compilerVer, snapConstraints) <- getResolverConstraints resolver
+    menv <- setupCabalEnv compilerVer
+
+    let -- Note - The order in Map.union below is important.
+        -- We want to override snapshot with extra deps
+        depConstraints = Map.union extraConstraints snapConstraints
+        -- Make sure deps do not include any src packages
+        -- There are two reasons for this:
+        -- 1. We do not want snapshot versions to override the sources
+        -- 2. Sources may not have versions leading to bad cabal constraints
+        depOnlyConstraints = Map.difference depConstraints srcConstraints
+        solver t = cabalSolver menv cabalDirs t
+                               srcConstraints depOnlyConstraints $
+                          ["-v"] -- TODO make it conditional on debug
+                       ++ ["--ghcjs" | (whichCompiler compilerVer) == Ghcjs]
+
+    let srcNames = (T.intercalate " and ") $
+          ["packages from " <> resolverName resolver
+              | not (Map.null snapConstraints)] ++
+          [T.pack ((show $ Map.size extraConstraints) <> " external packages")
+              | not (Map.null extraConstraints)]
+
+    $logInfo "Asking cabal to calculate a build plan..."
+    unless (Map.null depOnlyConstraints)
+        ($logInfo $ "Trying with " <> srcNames <> " as hard constraints...")
+
+    mdeps <- solver Constraint
+    mdeps' <- case mdeps of
+        Nothing | not (Map.null depOnlyConstraints) -> do
+            $logInfo $ "Retrying with " <> srcNames <> " as preferences..."
+            solver Preference
+        _ -> return mdeps
+
+    case mdeps' of
+        Just deps -> do
+            let
+                -- All src package constraints returned by cabal.
+                -- Flags may have changed.
+                srcs = Map.intersection deps srcConstraints
+                inSnap = Map.intersection deps snapConstraints
+                -- All packages which are in the snapshot but cabal solver
+                -- returned versions or flags different from the snapshot.
+                inSnapChanged = Map.differenceWith diffConstraints
+                                                   inSnap snapConstraints
+                -- Packages neither in snapshot, nor srcs
+                extra = Map.difference deps (Map.union srcConstraints
+                                                       snapConstraints)
+                external = Map.union inSnapChanged extra
+
+            $logInfo $ "Successfully determined a build plan with "
+                     <> T.pack (show $ Map.size external)
+                     <> " external dependencies."
+
+            return $ Just (srcs, external)
+        Nothing -> do
+            $logInfo $ "Failed to arrive at a workable build plan using "
+                       <> resolverName resolver <> " resolver."
+            return Nothing
+    where
+      mpiConstraints mpi = (mpiVersion mpi, mpiFlags mpi)
+      mbpConstraints mbp = fmap mpiConstraints (mbpPackages mbp)
+
+      getResolverConstraints (ResolverSnapshot snapName) = do
+          mbp <- loadMiniBuildPlan snapName
+          return (mbpCompilerVersion mbp, mbpConstraints mbp)
+
+      getResolverConstraints (ResolverCompiler compiler) =
+          return (compiler, Map.empty)
+
+      -- FIXME instead of passing the stackYaml dir we should maintain
+      -- the file URL in the custom resolver always relative to stackYaml.
+      getResolverConstraints (ResolverCustom _ url) = do
+          mbp <- parseCustomMiniBuildPlan stackYaml url
+          return (mbpCompilerVersion mbp, mbpConstraints mbp)
+
+-- | Given a bundle of packages and a resolver, check the resolver with respect
+-- to the packages and return how well the resolver satisfies the depndencies
+-- of the packages. If 'flags' is passed as 'Nothing' then flags are chosen
+-- automatically.
+
+checkResolverSpec
+    :: ( MonadIO m, MonadCatch m, MonadLogger m, MonadReader env m
+       , HasHttpManager env, HasConfig env, HasGHCVariant env
+       , MonadBaseControl IO m)
+    => [C.GenericPackageDescription]
+    -> Maybe (Map PackageName (Map FlagName Bool))
+    -> Resolver
+    -> m BuildPlanCheck
+checkResolverSpec gpds flags resolver = do
+    case resolver of
+      ResolverSnapshot name -> checkSnapBuildPlan gpds flags name
+      ResolverCompiler _ -> return $ BuildPlanCheckPartial Map.empty Map.empty
+      -- TODO support custom resolver for stack init
+      ResolverCustom _ _ -> return $ BuildPlanCheckPartial Map.empty Map.empty
+
+findCabalFiles :: MonadIO m => Bool -> Path Abs Dir -> m [Path Abs File]
+findCabalFiles recurse dir =
+    liftIO $ findFiles dir isCabal (\subdir -> recurse && not (isIgnored subdir))
+  where
+    isCabal path = ".cabal" `isSuffixOf` toFilePath path
+
+    isIgnored path = FP.dropTrailingPathSeparator (toFilePath (dirname path))
+                     `Set.member` ignoredDirs
+
+-- | Special directories that we don't want to traverse for .cabal files
+ignoredDirs :: Set FilePath
+ignoredDirs = Set.fromList
+    [ ".git"
+    , "dist"
+    , ".stack-work"
+    ]
+
+-- | Do some basic checks on a list of cabal file paths to be used for creating
+-- stack config, print some informative and error messages and if all is ok
+-- return @GenericPackageDescription@ list.
+cabalPackagesCheck
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+     => [Path Abs File]
+     -> String
+     -> String
+     -> m [C.GenericPackageDescription]
+cabalPackagesCheck cabalfps noPkgMsg dupPkgFooter = do
+    when (null cabalfps) $
+        error noPkgMsg
+
+    relpaths <- mapM makeRel cabalfps
+    $logInfo $ "Using cabal packages:"
+    $logInfo $ T.pack (formatGroup relpaths)
+
+    when (dupGroups relpaths /= []) $
+        error $ "Duplicate cabal package names cannot be used in a single "
+        <> "stack project. Following duplicates were found:\n"
+        <> intercalate "\n" (dupGroups relpaths)
+        <> "\n"
+        <> dupPkgFooter
+
+    (warnings,gpds) <- fmap unzip (mapM readPackageUnresolved cabalfps)
+    zipWithM_ (mapM_ . printCabalFileWarning) cabalfps warnings
+    return gpds
+
+    where
+        groups          = filter ((> 1) . length) . groupSortOn (FP.takeFileName)
+        dupGroups       = (map formatGroup) . groups
+
+makeRel :: (MonadIO m) => Path Abs File -> m FilePath
+makeRel = liftIO . makeRelativeToCurrentDirectory . toFilePath
+
+formatGroup :: [String] -> String
+formatGroup = concat . (map formatPath)
+    where formatPath path = "- " <> path <> "\n"
+
+reportMissingCabalFiles
+    :: (MonadIO m, MonadLogger m) => [Path Abs File] -> Bool -> m ()
+reportMissingCabalFiles cabalfps includeSubdirs = do
+    allCabalfps <- findCabalFiles (includeSubdirs) =<< getWorkingDir
+
+    relpaths <- mapM makeRel (allCabalfps \\ cabalfps)
+    when (not (null relpaths)) $ do
+        $logWarn $ "The following packages are missing from the config:"
+        $logWarn $ T.pack (formatGroup relpaths)
+
+-- | Solver can be thought of as a counterpart of init. init creates a
+-- stack.yaml whereas solver verifies or fixes an existing one. It can verify
+-- the dependencies of the packages and determine if any extra-dependecies
+-- outside the snapshots are needed.
+--
+-- TODO Currently solver uses a stack.yaml in the parent chain when there is
+-- no stack.yaml in the current directory. It should instead look for a
+-- stack yaml only in the current directory and suggest init if there is
+-- none available. That will make the behavior consistent with init and provide
+-- a correct meaning to a --ignore-subdirs option if implemented.
+
+solveExtraDeps
+    :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m
+       , MonadReader env m, HasConfig env , HasEnvConfig env, HasGHCVariant env
+       , HasHttpManager env , HasLogLevel env , HasReExec env
+       , HasTerminal env)
+    => Bool -- ^ modify stack.yaml?
+    -> m ()
 solveExtraDeps modStackYaml = do
     econfig <- asks getEnvConfig
     bconfig <- asks getBuildConfig
-    snapshot <-
-        case bcResolver bconfig of
-            ResolverSnapshot snapName -> liftM mbpPackages $ loadMiniBuildPlan snapName
-            ResolverCompiler _ -> return Map.empty
-            ResolverCustom _ url -> liftM mbpPackages $ parseCustomMiniBuildPlan
-                (bcStackYaml bconfig)
-                url
-
-    let packages = Map.union
-            (bcExtraDeps bconfig)
-            (mpiVersion <$> snapshot)
-
-    wc <- getWhichCompiler
-    (_compilerVersion, extraDeps) <- cabalSolver
-        wc
-        (Map.keys $ envConfigPackages econfig)
-        packages
-        (bcFlags bconfig)
-        []
-
-    let newDeps = extraDeps `Map.difference` packages
-        newFlags = Map.filter (not . Map.null) $ fmap snd newDeps
-
-    $logInfo "This command is not guaranteed to give you a perfect build plan"
-    if Map.null newDeps
-        then $logInfo "No needed changes found"
-        else do
-            $logInfo "It's possible that even with the changes generated below, you will still need to do some manual tweaking"
-            let o = object
-                    $ ("extra-deps" .= map fromTuple (Map.toList $ fmap fst newDeps))
-                    : (if Map.null newFlags
-                        then []
-                        else ["flags" .= newFlags])
-            mapM_ $logInfo $ T.lines $ decodeUtf8 $ Yaml.encode o
-
-    if modStackYaml
-      then do
-        let fp = toFilePath $ bcStackYaml bconfig
-        obj <- liftIO (Yaml.decodeFileEither fp) >>= either throwM return
-        (ProjectAndConfigMonoid project _, warnings) <-
-            liftIO (Yaml.decodeFileEither fp) >>= either throwM return
-        logJSONWarnings fp warnings
-        let obj' =
-                HashMap.insert "extra-deps"
-                    (toJSON $ map fromTuple $ Map.toList
-                            $ Map.union (projectExtraDeps project) (fmap fst newDeps))
-              $ HashMap.insert ("flags" :: Text)
-                    (toJSON $ Map.union (projectFlags project) newFlags)
-                obj
-        liftIO $ Yaml.encodeFile fp obj'
-        $logInfo $ T.pack $ "Updated " ++ fp
-      else do
+
+    let stackYaml = bcStackYaml bconfig
+    relStackYaml <- makeRel stackYaml
+
+    $logInfo $ "Using configuration file: " <> T.pack relStackYaml
+    let cabalDirs = Map.keys $ envConfigPackages econfig
+        noPkgMsg = "No cabal packages found in " <> relStackYaml <>
+                   ". Please add at least one directory containing a .cabal \
+                   \file. You can also use 'stack init' to automatically \
+                   \generate the config file."
+        dupPkgFooter = "Please remove the directories containing duplicate \
+                       \entries from '" <> relStackYaml <> "'."
+
+    cabalfps  <- liftM concat (mapM (findCabalFiles False) cabalDirs)
+    gpds <- cabalPackagesCheck cabalfps noPkgMsg dupPkgFooter
+
+    -- TODO when solver supports --ignore-subdirs option pass that as the
+    -- second argument here.
+    reportMissingCabalFiles cabalfps True
+
+    let oldFlags          = bcFlags bconfig
+        oldExtraVersions  = bcExtraDeps bconfig
+        resolver          = bcResolver bconfig
+        oldSrcs           = gpdPackages gpds
+        oldSrcFlags       = Map.intersection oldFlags oldSrcs
+        oldExtraFlags     = Map.intersection oldFlags oldExtraVersions
+
+        srcConstraints    = mergeConstraints oldSrcs oldSrcFlags
+        extraConstraints  = mergeConstraints oldExtraVersions oldExtraFlags
+
+    resolverResult <- checkResolverSpec gpds (Just oldSrcFlags) resolver
+    resultSpecs <- case resolverResult of
+        BuildPlanCheckOk flags ->
+            return $ Just ((mergeConstraints oldSrcs flags), Map.empty)
+        BuildPlanCheckPartial _ _ ->
+            solveResolverSpec stackYaml cabalDirs
+                              (resolver, srcConstraints, extraConstraints)
+        BuildPlanCheckFail f e c ->
+            throwM $ ResolverMismatch resolver (showCompilerErrors f e c)
+
+    (srcs, edeps) <- case resultSpecs of
+        Nothing -> throwM (SolverGiveUp giveUpMsg)
+        Just x -> return x
+
+    let
+        flags = removeSrcPkgDefaultFlags gpds (fmap snd (Map.union srcs edeps))
+        versions = fmap fst edeps
+
+        vDiff v v' = if v == v' then Nothing else Just v
+        versionsDiff = Map.differenceWith vDiff
+        newVersions  = versionsDiff versions oldExtraVersions
+        goneVersions = versionsDiff oldExtraVersions versions
+
+        fDiff f f' = if f == f' then Nothing else Just f
+        flagsDiff  = Map.differenceWith fDiff
+        newFlags   = flagsDiff flags oldFlags
+        goneFlags  = flagsDiff oldFlags flags
+
+        changed =    any (not . Map.null) [newVersions, goneVersions]
+                  || any (not . Map.null) [newFlags, goneFlags]
+
+    if changed then do
         $logInfo ""
-        $logInfo "To automatically modify your stack.yaml file, rerun with '--modify-stack-yaml'"
+        $logInfo $ "The following changes will be made to "
+                   <> T.pack relStackYaml <> ":"
+
+        -- TODO print whether resolver changed from previous
+        $logInfo $ "* Resolver is " <> resolverName resolver
+
+        -- TODO indent the yaml output
+        printFlags newFlags  "* Flags to be added"
+        printDeps  newVersions   "* Dependencies to be added"
+
+        printFlags goneFlags "* Flags to be deleted"
+        printDeps  goneVersions  "* Dependencies to be deleted"
+
+        -- TODO backup the old config file
+        if modStackYaml then do
+            writeStackYaml stackYaml resolver versions flags
+            $logInfo $ "Updated " <> T.pack relStackYaml
+        else do
+            $logInfo $ "To automatically update " <> T.pack relStackYaml
+                       <> ", rerun with '--update-config'"
+     else
+        $logInfo $ "No changes needed to " <> T.pack relStackYaml
+
+    where
+        indent t = T.unlines $ fmap ("    " <>) (T.lines t)
+
+        printFlags fl msg = do
+            when ((not . Map.null) fl) $ do
+                $logInfo $ T.pack msg
+                $logInfo $ indent $ decodeUtf8 $ Yaml.encode
+                                  $ object ["flags" .= fl]
+
+        printDeps deps msg = do
+            when ((not . Map.null) deps) $ do
+                $logInfo $ T.pack msg
+                $logInfo $ indent $ decodeUtf8 $ Yaml.encode $ object $
+                        [("extra-deps" .= map fromTuple (Map.toList deps))]
+
+        writeStackYaml path res deps fl = do
+            let fp = toFilePath path
+            obj <- liftIO (Yaml.decodeFileEither fp) >>= either throwM return
+            (ProjectAndConfigMonoid _ _, warnings) <-
+                liftIO (Yaml.decodeFileEither fp) >>= either throwM return
+            logJSONWarnings fp warnings
+            let obj' =
+                    HashMap.insert "extra-deps"
+                        (toJSON $ map fromTuple $ Map.toList deps)
+                  $ HashMap.insert ("flags" :: Text) (toJSON fl)
+                  $ HashMap.insert ("resolver" :: Text) (toJSON (resolverName res)) obj
+            liftIO $ Yaml.encodeFile fp obj'
+
+        giveUpMsg = concat
+            [ "    - Update external packages with 'stack update' and try again.\n"
+            , "    - Tweak " <> toFilePath stackDotYaml <> " and try again\n"
+            , "        - Remove any unnecessary packages.\n"
+            , "        - Add any missing remote packages.\n"
+            , "        - Add extra dependencies to guide solver.\n"
+            ]
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index b0c4756fcc..d95d80a359 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -120,9 +120,8 @@ data StackBuildException
   | InvalidFlagSpecification (Set UnusedFlags)
   | TargetParseException [Text]
   | DuplicateLocalPackageNames [(PackageName, [Path Abs Dir])]
+  | SolverGiveUp String
   | SolverMissingCabalInstall
-  | SolverMissingGHC
-  | SolverNoCabalFiles
   | SomeTargetsNotBuildable [(PackageName, NamedComponent)]
   deriving Typeable
 
@@ -322,18 +321,15 @@ instance Show StackBuildException where
             : (packageNameString name ++ " used in:")
             : map goDir dirs
         goDir dir = "- " ++ toFilePath dir
+    show (SolverGiveUp msg) = concat
+        [ "\nSolver could not resolve package dependencies.\n"
+        , "You can try the following:\n"
+        , msg
+        ]
     show SolverMissingCabalInstall = unlines
         [ "Solver requires that cabal be on your PATH"
         , "Try running 'stack install cabal-install'"
         ]
-    show SolverMissingGHC = unlines
-        [ "Solver requires that GHC be on your PATH"
-        , "Try running 'stack setup'"
-        ]
-    show SolverNoCabalFiles = unlines
-        [ "No cabal files provided.  Maybe this is due to not having a stack.yaml file?"
-        , "Try running 'stack init' to create a stack.yaml"
-        ]
     show (SomeTargetsNotBuildable xs) =
         "The following components have 'buildable: False' set in the cabal configuration, and so cannot be targets:\n    " ++
         T.unpack (renderPkgComponents xs) ++
diff --git a/src/Stack/Types/BuildPlan.hs b/src/Stack/Types/BuildPlan.hs
index 85cc1782b4..f44f7593d2 100644
--- a/src/Stack/Types/BuildPlan.hs
+++ b/src/Stack/Types/BuildPlan.hs
@@ -15,6 +15,7 @@ module Stack.Types.BuildPlan
     , Maintainer (..)
     , ExeName (..)
     , SimpleDesc (..)
+    , Snapshots (..)
     , DepInfo (..)
     , Component (..)
     , SnapName (..)
@@ -34,6 +35,8 @@ import           Data.Aeson                      (FromJSON (..), ToJSON (..),
 import           Data.Binary.VersionTagged
 import           Data.Hashable                   (Hashable)
 import qualified Data.HashMap.Strict             as HashMap
+import           Data.IntMap                     (IntMap)
+import qualified Data.IntMap                     as IntMap
 import           Data.Map                        (Map)
 import qualified Data.Map                        as Map
 import           Data.Maybe                      (fromMaybe)
@@ -359,6 +362,34 @@ parseSnapName t0 =
         t1 <- T.stripPrefix "nightly-" t0
         Nightly <$> readMay (T.unpack t1)
 
+-- | Most recent Nightly and newest LTS version per major release.
+data Snapshots = Snapshots
+    { snapshotsNightly :: !Day
+    , snapshotsLts     :: !(IntMap Int)
+    }
+    deriving Show
+instance FromJSON Snapshots where
+    parseJSON = withObject "Snapshots" $ \o -> Snapshots
+        <$> (o .: "nightly" >>= parseNightly)
+        <*> (fmap IntMap.unions
+                $ mapM (parseLTS . snd)
+                $ filter (isLTS . fst)
+                $ HashMap.toList o)
+      where
+        parseNightly t =
+            case parseSnapName t of
+                Left e -> fail $ show e
+                Right (LTS _ _) -> fail "Unexpected LTS value"
+                Right (Nightly d) -> return d
+
+        isLTS = ("lts-" `T.isPrefixOf`)
+
+        parseLTS = withText "LTS" $ \t ->
+            case parseSnapName t of
+                Left e -> fail $ show e
+                Right (LTS x y) -> return $ IntMap.singleton x y
+                Right (Nightly _) -> fail "Unexpected nightly value"
+
 instance ToJSON a => ToJSON (Map ExeName a) where
   toJSON = toJSON . Map.mapKeysWith const unExeName
 instance FromJSON a => FromJSON (Map ExeName a) where
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
index cc7caecb5e..311af287f0 100644
--- a/src/Stack/Types/Config.hs
+++ b/src/Stack/Types/Config.hs
@@ -1075,6 +1075,8 @@ data ConfigException
   | UnexpectedTarballContents [Path Abs Dir] [Path Abs File]
   | BadStackVersionException VersionRange
   | NoMatchingSnapshot [SnapName]
+  | ResolverMismatch Resolver Text
+  | ResolverPartial Resolver Text
   | NoSuchDirectory FilePath
   | ParseGHCVariantException String
   deriving Typeable
@@ -1115,16 +1117,29 @@ instance Show ConfigException where
         , T.unpack (versionRangeText requiredRange)
         , ")." ]
     show (NoMatchingSnapshot names) = concat
-        [ "There was no snapshot found that matched the package "
-        , "bounds in your .cabal files.\n"
-        , "Please choose one of the following commands to get started.\n\n"
-        , unlines $ map
-            (\name -> "    stack init --resolver " ++ T.unpack (renderSnapName name))
-            names
-        , "\nYou'll then need to add some extra-deps. See:\n\n"
-        , "    http://docs.haskellstack.org/en/stable/yaml_configuration.html#extra-deps"
-        , "\n\nYou can also try falling back to a dependency solver with:\n\n"
-        , "    stack init --solver"
+        [ "None of the following snapshots provides a compiler matching "
+        , "your package(s):\n"
+        , unlines $ map (\name -> "    - " <> T.unpack (renderSnapName name))
+                        names
+        , "\nYou can try the following options:\n"
+        , "    - Exclude mismatching package(s) and build the rest.\n"
+        , "        - Use '--ignore-subdirs' to exclude subdirectories.\n"
+        , "        - Manually create a config, then use 'stack solver'\n"
+        , "    - Use '--resolver' to specify a matching snapshot/resolver\n"
+        , "    - Use a custom snapshot having the right compiler.\n"
+        ]
+    show (ResolverMismatch resolver errDesc) = concat
+        [ "Selected resolver '"
+        , T.unpack (resolverName resolver)
+        , "' does not have a matching compiler to build your package(s).\n"
+        , T.unpack errDesc
+        ]
+    show (ResolverPartial resolver errDesc) = concat
+        [ "Selected resolver '"
+        , T.unpack (resolverName resolver)
+        , "' does not have all the packages to match your requirements.\n"
+        , T.unpack $ T.unlines $ fmap ("    " <>) (T.lines errDesc)
+        , "\nHowever, you can try '--solver' to use external packages."
         ]
     show (NoSuchDirectory dir) = concat
         ["No directory could be located matching the supplied path: "
diff --git a/src/System/Process/Read.hs b/src/System/Process/Read.hs
index a28370a3f3..8f92fd1089 100644
--- a/src/System/Process/Read.hs
+++ b/src/System/Process/Read.hs
@@ -198,7 +198,7 @@ instance Show ReadProcessException where
         maybe [] (\x -> [" in directory ", x]) (cwd cp) ++
         [ " exited with "
         , show ec
-        , "\n"
+        , "\n\n"
         , toStr out
         , "\n"
         , toStr err
diff --git a/src/main/Main.hs b/src/main/Main.hs
index c2b460d0d4..73d6e43d09 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -1166,23 +1166,30 @@ loadConfigWithOpts go@GlobalOpts{..} = do
         return lc
     return (manager,lc)
 
--- | Project initialization
-initCmd :: InitOpts -> GlobalOpts -> IO ()
-initCmd initOpts go =
-    withConfigAndLock go $
-    do pwd <- getWorkingDir
+withMiniConfigAndLock
+    :: GlobalOpts
+    -> StackT MiniConfig (StackT Config IO) ()
+    -> IO ()
+withMiniConfigAndLock go inner =
+    withConfigAndLock go $ do
        config <- asks getConfig
        miniConfig <- loadMiniConfig config
-       runReaderT (initProject pwd initOpts) miniConfig
+       manager <- asks getHttpManager
+       runStackTGlobal manager miniConfig go inner
+
+-- | Project initialization
+initCmd :: InitOpts -> GlobalOpts -> IO ()
+initCmd initOpts go = do
+    pwd <- getWorkingDir
+    withMiniConfigAndLock go (initProject pwd initOpts)
 
 -- | Create a project directory structure and initialize the stack config.
 newCmd :: (NewOpts,InitOpts) -> GlobalOpts -> IO ()
-newCmd (newOpts,initOpts) go@GlobalOpts{..} =
-    withConfigAndLock go $
-    do dir <- new newOpts
-       config <- asks getConfig
-       miniConfig <- loadMiniConfig config
-       runReaderT (initProject dir initOpts) miniConfig
+newCmd (newOpts,initOpts) go@GlobalOpts{..} = do
+    withMiniConfigAndLock go $ do
+        dir <- new newOpts
+        initProject dir initOpts
+
 
 -- | List the available templates.
 templatesCmd :: () -> GlobalOpts -> IO ()