From 91bb0bb771172f9ec5a2a32d18ec3e8382ae7793 Mon Sep 17 00:00:00 2001
From: Harendra Kumar <harendra.kumar@gmail.com>
Date: Sun, 17 Jan 2016 15:18:06 +0530
Subject: [PATCH] stack init: add --omit-packages CLI option

Remove the overloading of --force option and use it exclusively for overwriting
an existing config. Use a separate --omit-packages option for excluding
conflicting or incompatible packages from generated config.

See #1621
---
 src/Stack/Init.hs         | 17 +++++++++--------
 src/Stack/Options.hs      |  8 +++++---
 src/Stack/Types/Config.hs | 11 +++++++----
 3 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs
index c92ed70a7f..686943575a 100644
--- a/src/Stack/Init.hs
+++ b/src/Stack/Init.hs
@@ -289,7 +289,7 @@ getDefaultResolver stackYaml initOpts bundle =
             let gpds = Map.elems (fmap snd bundle)
             (s, r) <- selectBestSnapshot gpds snaps
             case r of
-                (BuildPlanCheckFail _ _ _) | not (forceOverwrite initOpts)
+                (BuildPlanCheckFail _ _ _) | not (omitPackages initOpts)
                         -> throwM (NoMatchingSnapshot snaps)
                 _ -> return $ ResolverSnapshot s
 
@@ -367,7 +367,7 @@ checkBundleResolver stackYaml initOpts bundle resolver = do
                 solve f
             | otherwise -> throwM $ ResolverPartial resolver (show result)
         (BuildPlanCheckFail _ e _)
-            | (forceOverwrite initOpts) -> do
+            | (omitPackages initOpts) -> do
                 $logWarn $ "*** Resolver compiler mismatch: "
                            <> resolverName resolver
                 $logWarn $ indent $ T.pack $ show result
@@ -387,7 +387,7 @@ checkBundleResolver stackYaml initOpts bundle resolver = do
               Right (src, ext) ->
                   return $ Right (fmap snd (Map.union src ext), fmap fst ext)
               Left packages
-                  | forceOverwrite initOpts, srcpkgs /= []-> do
+                  | omitPackages initOpts, srcpkgs /= []-> do
                       pkg <- findOneIndependent srcpkgs flags
                       return $ Left [pkg]
                   | otherwise -> throwM (SolverGiveUp giveUpMsg)
@@ -409,13 +409,12 @@ checkBundleResolver stackYaml initOpts bundle resolver = do
           return $ head (filter isIndependent packages)
 
       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"
+          [ "    - Use '--omit-packages to exclude conflicting package(s).\n"
+          , "    - Tweak the generated "
+          , toFilePath stackDotYaml <> " and then run 'stack solver':\n"
           , "        - Add any missing remote packages.\n"
           , "        - Add extra dependencies to guide solver.\n"
+          , "    - Update external packages with 'stack update' and try again.\n"
           ]
 
       needSolver _ (InitOpts {useSolver = True}) = True
@@ -462,6 +461,8 @@ data InitOpts = InitOpts
     -- ^ Use solver
     , useSolver :: Bool
     -- ^ Preferred snapshots
+    , omitPackages :: Bool
+    -- ^ Exclude conflicting or incompatible packages
     , forceOverwrite :: Bool
     -- ^ Overwrite existing files
     , includeSubDirs :: Bool
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
index 4851771498..ae179e4e4e 100644
--- a/src/Stack/Options.hs
+++ b/src/Stack/Options.hs
@@ -670,13 +670,15 @@ globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts
 
 initOptsParser :: Parser InitOpts
 initOptsParser =
-    InitOpts <$> method <*> solver <*> overwrite <*> fmap not ignoreSubDirs
+    InitOpts <$> method <*> solver <*> omitPackages
+             <*> 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 an existing stack.yaml or \
-                            \creating a stack.yaml with incomplete config.")
+                       help "Force overwriting an existing stack.yaml")
+    omitPackages = switch (long "omit-packages" <>
+                           help "Exlcude conflicting or incompatible packages")
     solver = switch (long "solver" <>
              help "Use a dependency solver to determine extra dependencies")
 
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
index 0ee37113f7..688d1623a5 100644
--- a/src/Stack/Types/Config.hs
+++ b/src/Stack/Types/Config.hs
@@ -1127,17 +1127,20 @@ instance Show ConfigException where
         , unlines $ map (\name -> "    - " <> T.unpack (renderSnapName name))
                         names
         , "\nYou can try the following options:\n"
-        , "    - Use '--force' to ignore mismatching package(s).\n"
+        , "    - Use '--omit-packages to exclude mismatching package(s).\n"
         , "    - Use '--resolver' to specify a matching snapshot/resolver\n"
         ]
     show (ResolverMismatch resolver errDesc) = concat
-        [ "Selected resolver '"
+        [ "Resolver '"
         , T.unpack (resolverName resolver)
-        , "' does not have a matching compiler to build your package(s).\n"
+        , "' 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)."
         ]
     show (ResolverPartial resolver errDesc) = concat
-        [ "Selected resolver '"
+        [ "Resolver '"
         , T.unpack (resolverName resolver)
         , "' does not have all the packages to match your requirements.\n"
         , unlines $ fmap ("    " <>) (lines errDesc)