Don't have "stack solver" suggest --omit-packages #2031

src/Stack/Init.hs

@@ -55,11 +55,12 @@ initProject
        , MonadReader env m, HasConfig env , HasGHCVariant env
        , HasHttpManager env , HasLogLevel env , HasReExec env
        , HasTerminal env)
-    => Path Abs Dir
+    => WhichSolverCmd
+    -> Path Abs Dir
     -> InitOpts
     -> Maybe AbstractResolver
     -> m ()
-initProject currDir initOpts mresolver = do
+initProject whichCmd currDir initOpts mresolver = do
     let dest = currDir </> stackDotYaml
 
     reldest <- toFilePath `liftM` makeRelativeToCurrentDir dest
@@ -79,7 +80,7 @@ initProject currDir initOpts mresolver = do
     cabalfps <- liftM concat $ mapM find dirs'
     (bundle, dupPkgs)  <- cabalPackagesCheck cabalfps noPkgMsg Nothing
 
-    (r, flags, extraDeps, rbundle) <- getDefaultResolver dest initOpts
+    (r, flags, extraDeps, rbundle) <- getDefaultResolver whichCmd dest initOpts
                                                          mresolver bundle
 
     let ignored = Map.difference bundle rbundle
@@ -331,7 +332,8 @@ getDefaultResolver
        , MonadReader env m, HasConfig env , HasGHCVariant env
        , HasHttpManager env , HasLogLevel env , HasReExec env
        , HasTerminal env)
-    => Path Abs File   -- ^ stack.yaml
+    => WhichSolverCmd
+    -> Path Abs File   -- ^ stack.yaml
     -> InitOpts
     -> Maybe AbstractResolver
     -> Map PackageName (Path Abs File, C.GenericPackageDescription)
@@ -344,9 +346,9 @@ getDefaultResolver
        --   , Flags for src packages and extra deps
        --   , Extra dependencies
        --   , Src packages actually considered)
-getDefaultResolver stackYaml initOpts mresolver bundle =
+getDefaultResolver whichCmd stackYaml initOpts mresolver bundle =
     maybe selectSnapResolver makeConcreteResolver mresolver
-      >>= getWorkingResolverPlan stackYaml initOpts bundle
+      >>= getWorkingResolverPlan whichCmd stackYaml initOpts bundle
     where
         -- TODO support selecting best across regular and custom snapshots
         selectSnapResolver = do
@@ -355,15 +357,16 @@ getDefaultResolver stackYaml initOpts mresolver bundle =
             (s, r) <- selectBestSnapshot gpds snaps
             case r of
                 BuildPlanCheckFail {} | not (omitPackages initOpts)
-                        -> throwM (NoMatchingSnapshot snaps)
+                        -> throwM (NoMatchingSnapshot whichCmd snaps)
                 _ -> return $ ResolverSnapshot s
 
 getWorkingResolverPlan
     :: ( 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
+    => WhichSolverCmd
+    -> Path Abs File   -- ^ stack.yaml
     -> InitOpts
     -> Map PackageName (Path Abs File, C.GenericPackageDescription)
        -- ^ Src package name: cabal dir, cabal package description
@@ -376,12 +379,12 @@ getWorkingResolverPlan
        --   , Flags for src packages and extra deps
        --   , Extra dependencies
        --   , Src packages actually considered)
-getWorkingResolverPlan stackYaml initOpts bundle resolver = do
+getWorkingResolverPlan whichCmd stackYaml initOpts bundle resolver = do
     $logInfo $ "Selected resolver: " <> resolverName resolver
     go bundle
     where
         go info = do
-            eres <- checkBundleResolver stackYaml initOpts info resolver
+            eres <- checkBundleResolver whichCmd stackYaml initOpts info resolver
             -- if some packages failed try again using the rest
             case eres of
                 Right (f, edeps)-> return (resolver, f, edeps, info)
@@ -413,14 +416,15 @@ checkBundleResolver
        , MonadReader env m, HasConfig env , HasGHCVariant env
        , HasHttpManager env , HasLogLevel env , HasReExec env
        , HasTerminal env)
-    => Path Abs File   -- ^ stack.yaml
+    => WhichSolverCmd
+    -> Path Abs File   -- ^ stack.yaml
     -> InitOpts
     -> Map PackageName (Path Abs File, C.GenericPackageDescription)
        -- ^ Src package name: cabal dir, cabal package description
     -> Resolver
     -> m (Either [PackageName] ( Map PackageName (Map FlagName Bool)
                                , Map PackageName Version))
-checkBundleResolver stackYaml initOpts bundle resolver = do
+checkBundleResolver whichCmd stackYaml initOpts bundle resolver = do
     result <- checkResolverSpec gpds Nothing resolver
     case result of
         BuildPlanCheckOk f -> return $ Right (f, Map.empty)
@@ -432,14 +436,14 @@ checkBundleResolver stackYaml initOpts bundle resolver = do
                 warnPartial result
                 $logWarn "*** Omitting packages with unsatisfied dependencies"
                 return $ Left $ failedUserPkgs e
-            | otherwise -> throwM $ ResolverPartial resolver (show result)
+            | otherwise -> throwM $ ResolverPartial whichCmd resolver (show result)
         BuildPlanCheckFail _ e _
             | omitPackages initOpts -> do
                 $logWarn $ "*** Resolver compiler mismatch: "
                            <> resolverName resolver
                 $logWarn $ indent $ T.pack $ show result
                 return $ Left $ failedUserPkgs e
-            | otherwise -> throwM $ ResolverMismatch resolver (show result)
+            | otherwise -> throwM $ ResolverMismatch whichCmd resolver (show result)
     where
       indent t  = T.unlines $ fmap ("    " <>) (T.lines t)
       warnPartial res = do

src/Stack/Solver.hs

@@ -673,7 +673,7 @@ solveExtraDeps modStackYaml = do
             -- packages
             return $ either (const Nothing) Just eres
         BuildPlanCheckFail {} ->
-            throwM $ ResolverMismatch resolver (show resolverResult)
+            throwM $ ResolverMismatch IsSolverCmd resolver (show resolverResult)
 
     (srcs, edeps) <- case resultSpecs of
         Nothing -> throwM (SolverGiveUp giveUpMsg)

src/Stack/Types/Config.hs

@@ -54,6 +54,8 @@ module Stack.Types.Config
   ,ApplyGhcOptions(..)
   -- ** ConfigException
   ,ConfigException(..)
+  -- ** WhichSolverCmd
+  ,WhichSolverCmd(..)
   -- ** ConfigMonoid
   ,ConfigMonoid(..)
   -- ** EnvSettings
@@ -1076,9 +1078,9 @@ data ConfigException
   | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File]
   | UnableToExtractArchive Text (Path Abs File)
   | BadStackVersionException VersionRange
-  | NoMatchingSnapshot (NonEmpty SnapName)
-  | forall l. ResolverMismatch (ResolverThat's l) String
-  | ResolverPartial Resolver String
+  | NoMatchingSnapshot WhichSolverCmd (NonEmpty SnapName)
+  | forall l. ResolverMismatch WhichSolverCmd (ResolverThat's l) String
+  | ResolverPartial WhichSolverCmd Resolver String
   | NoSuchDirectory FilePath
   | ParseGHCVariantException String
   | BadStackRoot (Path Abs Dir)
@@ -1133,31 +1135,27 @@ instance Show ConfigException where
         ,"version range specified in stack.yaml ("
         , T.unpack (versionRangeText requiredRange)
         , ")." ]
-    show (NoMatchingSnapshot names) = concat
+    show (NoMatchingSnapshot whichCmd names) = concat $
         [ "None of the following snapshots provides a compiler matching "
         , "your package(s):\n"
         , unlines $ map (\name -> "    - " <> T.unpack (renderSnapName name))
                         (NonEmpty.toList names)
-        , "\nYou can try the following options:\n"
-        , "    - Use '--omit-packages to exclude mismatching package(s).\n"
-        , "    - Use '--resolver' to specify a matching snapshot/resolver\n"
+        , showOptions whichCmd
         ]
-    show (ResolverMismatch resolver errDesc) = concat
+    show (ResolverMismatch whichCmd resolver errDesc) = concat
         [ "Resolver '"
         , T.unpack (resolverName resolver)
         , "' does not have a matching compiler to build some or all of your "
         , "package(s).\n"
         , errDesc
-        , "\nHowever, you can try '--omit-packages to exclude mismatching "
-        , "package(s)."
+        , showOptions whichCmd
         ]
-    show (ResolverPartial resolver errDesc) = concat
+    show (ResolverPartial whichCmd resolver errDesc) = concat
         [ "Resolver '"
         , T.unpack (resolverName resolver)
         , "' does not have all the packages to match your requirements.\n"
         , unlines $ fmap ("    " <>) (lines errDesc)
-        , "\nHowever, you can try '--solver' to use external packages."
-        , "\nUse '--omit-packages' if you want to create a config anyway."
+        , showOptions whichCmd
         ]
     show (NoSuchDirectory dir) = concat
         ["No directory could be located matching the supplied path: "
@@ -1189,6 +1187,20 @@ instance Show ConfigException where
         ]
 instance Exception ConfigException
 
+showOptions :: WhichSolverCmd -> String
+showOptions whichCmd = unlines $ ["\nThis may be resolved by:"] ++ options
+  where
+    options =
+        case whichCmd of
+            IsSolverCmd -> [useResolver]
+            IsInitCmd -> both
+            IsNewCmd -> both
+    both = [omitPackages, useResolver]
+    omitPackages = "    - Using '--omit-packages to exclude mismatching package(s)."
+    useResolver  = "    - Using '--resolver' to specify a matching snapshot/resolver"
+
+data WhichSolverCmd = IsInitCmd | IsSolverCmd | IsNewCmd
+
 -- | Helper function to ask the environment and apply getConfig
 askConfig :: (MonadReader env m, HasConfig env) => m Config
 askConfig = liftM getConfig ask

src/main/Main.hs

@@ -1227,14 +1227,14 @@ withMiniConfigAndLock go@GlobalOpts{..} inner = do
 initCmd :: InitOpts -> GlobalOpts -> IO ()
 initCmd initOpts go = do
     pwd <- getCurrentDir
-    withMiniConfigAndLock go (initProject pwd initOpts (globalResolver go))
+    withMiniConfigAndLock go (initProject IsInitCmd 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 (forceOverwrite initOpts)
-        initProject dir initOpts globalResolver
+        initProject IsNewCmd dir initOpts globalResolver
 
 -- | List the available templates.
 templatesCmd :: () -> GlobalOpts -> IO ()